section \<open> Closed Extensional Mereology \<close>

(*<*)
theory CEM
  imports CM EM
begin
(*>*)

text \<open> Closed extensional mereology combines closed mereology with extensional mereology.\footnote{
See \<^cite>\<open>"varzi_parts_1996"\<close> p. 263 and \<^cite>\<open>"casati_parts_1999"\<close> p. 43.} \<close>

locale CEM = CM + EM

text \<open> Likewise, closed minimal mereology combines closed mereology with minimal mereology.\footnote{
See \<^cite>\<open>"casati_parts_1999"\<close> p. 43.} \<close>

locale CMM = CM + MM

text \<open> But famously closed minimal mereology and closed extensional mereology are the same theory,
because in closed minimal mereology product closure and weak supplementation entail strong
supplementation.\footnote{See \<^cite>\<open>"simons_parts:_1987"\<close> p. 31 and \<^cite>\<open>"casati_parts_1999"\<close> p. 44.} \<close>

sublocale CMM \<subseteq> CEM
proof
  fix x y
  show strong_supplementation: "\<not> P x y \<Longrightarrow> (\<exists> z. P z x \<and> \<not> O z y)"
  proof -
    assume "\<not> P x y"
    show "\<exists> z. P z x \<and> \<not> O z y"
    proof cases
      assume "O x y"
      with \<open>\<not> P x y\<close> have "\<not> P x y \<and> O x y"..
      hence "PP (x \<otimes> y) x" by (rule nonpart_implies_proper_product)
      hence "\<exists> z. P z x \<and> \<not> O z (x \<otimes> y)" by (rule weak_supplementation)
      then obtain z where z: "P z x \<and> \<not> O z (x \<otimes> y)"..
      hence "\<not> O z y" by (rule disjoint_from_second_factor)
      moreover from z have "P z x"..
      hence  "P z x \<and> \<not> O z y"
        using \<open>\<not> O z y\<close>..
      thus "\<exists> z. P z x \<and> \<not> O z y"..
    next
      assume "\<not> O x y"
      with part_reflexivity have "P x x \<and> \<not> O x y"..
      thus "(\<exists> z. P z x \<and> \<not> O z y)"..
    qed
  qed
qed

sublocale CEM \<subseteq> CMM..

subsection \<open> Sums \<close>

context CEM
begin

lemma sum_intro:
   "(\<forall> w. O w z \<longleftrightarrow> (O w x \<or> O w y)) \<Longrightarrow> x \<oplus> y = z"
proof -
  assume sum: "\<forall> w. O w z \<longleftrightarrow> (O w x \<or> O w y)"
  hence "(THE v. \<forall> w. O w v \<longleftrightarrow> (O w x \<or> O w y)) = z"
  proof (rule the_equality)
    fix a
    assume a: "\<forall> w. O w a \<longleftrightarrow> (O w x \<or> O w y)"
    have "\<forall> w. O w a \<longleftrightarrow> O w z"
    proof
      fix w
      from sum have "O w z \<longleftrightarrow> (O w x \<or> O w y)"..
      moreover from a have "O w a \<longleftrightarrow> (O w x \<or> O w y)"..
      ultimately show "O w a \<longleftrightarrow> O w z" by (rule ssubst)
      qed
      with overlap_extensionality show "a = z"..
  qed
  thus "x \<oplus> y = z"
    using sum_eq by (rule subst)
qed

lemma sum_idempotence: "x \<oplus> x = x"
proof -
  have "\<forall> w. O w x \<longleftrightarrow> (O w x \<or> O w x)"
  proof
    fix w
    show "O w x \<longleftrightarrow> (O w x \<or> O w x)"
    proof (rule iffI)
      assume "O w x"
      thus "O w x \<or> O w x"..
    next
      assume "O w x \<or> O w x"
      thus "O w x" by (rule disjE)
    qed
  qed
  thus "x \<oplus> x = x" by (rule sum_intro)
qed

lemma part_sum_identity: "P y x \<Longrightarrow> x \<oplus> y = x"
proof -
  assume "P y x"
  have "\<forall> w. O w x \<longleftrightarrow> (O w x \<or> O w y)"
  proof
    fix w
    show "O w x \<longleftrightarrow> (O w x \<or> O w y)"
    proof
      assume "O w x"
      thus "O w x \<or> O w y"..
    next
      assume "O w x \<or> O w y"
      thus "O w x"
      proof
        assume "O w x"
        thus "O w x".
      next
        assume "O w y"
        with \<open>P y x\<close> show "O w x"
          by (rule overlap_monotonicity)
      qed
    qed
  qed
  thus "x \<oplus> y = x" by (rule sum_intro)
qed

lemma sum_character: "\<forall> w. O w (x \<oplus> y) \<longleftrightarrow> (O w x \<or> O w y)"
proof -
  from sum_closure have "(\<exists> z. \<forall> w. O w z \<longleftrightarrow> (O w x \<or> O w y))".
  then obtain a where a: "\<forall> w. O w a \<longleftrightarrow> (O w x \<or> O w y)"..
  hence "x \<oplus> y = a" by (rule sum_intro)
  thus "\<forall> w. O w (x \<oplus> y) \<longleftrightarrow> (O w x \<or> O w y)"
    using a by (rule ssubst)
qed

lemma sum_overlap: "O w (x \<oplus> y) \<longleftrightarrow> (O w x \<or> O w y)"
  using sum_character..

lemma sum_part_character:
  "P w (x \<oplus> y) \<longleftrightarrow> (\<forall> v. O v w \<longrightarrow> O v x \<or> O v y)"
proof
  assume "P w (x \<oplus> y)"
  show "\<forall> v. O v w \<longrightarrow> O v x \<or> O v y"
  proof
    fix v
    show "O v w \<longrightarrow> O v x \<or> O v y"
    proof
      assume "O v w"
      with \<open>P w (x \<oplus> y)\<close> have "O v (x \<oplus> y)"
        by (rule overlap_monotonicity)
      with sum_overlap show "O v x \<or> O v y"..
    qed
  qed
next
  assume right: "\<forall> v. O v w \<longrightarrow> O v x \<or> O v y"
  have "\<forall> v. O v w \<longrightarrow> O v (x \<oplus> y)"
  proof
    fix v
    from right have "O v w \<longrightarrow> O v x \<or> O v y"..
    with sum_overlap show "O v w \<longrightarrow> O v (x \<oplus> y)"
      by (rule ssubst)
  qed
  with part_overlap_eq show "P w (x \<oplus> y)"..
qed

lemma sum_commutativity: "x \<oplus> y = y \<oplus> x"
proof -
  from sum_character have "\<forall> w. O w (y \<oplus> x) \<longleftrightarrow> O w y \<or> O w x".
  hence "\<forall> w. O w (y \<oplus> x) \<longleftrightarrow> O w x \<or> O w y" by metis
  thus "x \<oplus> y = y \<oplus> x" by (rule sum_intro)
qed

lemma first_summand_overlap: "O z x \<Longrightarrow> O z (x \<oplus> y)"
proof -
  assume "O z x"
  hence "O z x \<or> O z y"..
  with sum_overlap show "O z (x \<oplus> y)"..
qed

lemma first_summand_disjointness: "\<not> O z (x \<oplus> y) \<Longrightarrow> \<not> O z x"
proof -
  assume "\<not> O z (x \<oplus> y)"
  show "\<not> O z x"
  proof
    assume "O z x"
    hence "O z (x \<oplus> y)" by (rule first_summand_overlap)
    with \<open>\<not> O z (x \<oplus> y)\<close> show "False"..
  qed
qed

lemma first_summand_in_sum: "P x (x \<oplus> y)"
proof -
  have "\<forall> w. O w x \<longrightarrow> O w (x \<oplus> y)"
  proof
    fix w
    show "O w x \<longrightarrow> O w (x \<oplus> y)"
    proof
      assume "O w x"
      thus "O w (x \<oplus> y)"
        by (rule first_summand_overlap)
    qed
  qed
  with part_overlap_eq show "P x (x \<oplus> y)"..
qed

lemma common_first_summand: "P x (x \<oplus> y) \<and> P x (x \<oplus> z)"
proof
  from first_summand_in_sum show "P x (x \<oplus> y)".
  from first_summand_in_sum show "P x (x \<oplus> z)".
qed

lemma common_first_summand_overlap: "O (x \<oplus> y) (x \<oplus> z)"
proof -
  from first_summand_in_sum have "P x (x \<oplus> y)".
  moreover from first_summand_in_sum have "P x (x \<oplus> z)".
  ultimately have "P x (x \<oplus> y) \<and> P x (x \<oplus> z)"..
  hence "\<exists> v. P v (x \<oplus> y) \<and> P v (x \<oplus> z)"..
  with overlap_eq show ?thesis..
qed

lemma second_summand_overlap: "O z y \<Longrightarrow> O z (x \<oplus> y)"
proof -
  assume "O z y"
  from sum_character have "O z (x \<oplus> y) \<longleftrightarrow> (O z x \<or> O z y)"..
  moreover from \<open>O z y\<close> have "O z x \<or> O z y"..
  ultimately show "O z (x \<oplus> y)"..
qed

lemma second_summand_disjointness: "\<not> O z (x \<oplus> y) \<Longrightarrow> \<not> O z y"
proof -
  assume "\<not> O z (x \<oplus> y)"
  show "\<not> O z y"
  proof
    assume  "O z y"
    hence "O z (x \<oplus> y)"
      by (rule second_summand_overlap)
    with \<open>\<not> O z (x \<oplus> y)\<close> show False..
  qed
qed

lemma second_summand_in_sum: "P y (x \<oplus> y)"
proof -
  have "\<forall> w. O w y \<longrightarrow> O w (x \<oplus> y)"
  proof
    fix w
    show "O w y \<longrightarrow> O w (x \<oplus> y)"
    proof
      assume "O w y"
      thus "O w (x \<oplus> y)"
        by (rule second_summand_overlap)
    qed
  qed
  with part_overlap_eq show "P y (x \<oplus> y)"..
qed

lemma second_summands_in_sums: "P y (x \<oplus> y) \<and> P v (z \<oplus> v)"
proof
  show "P y (x \<oplus> y)" using second_summand_in_sum.
  show "P v (z \<oplus> v)" using second_summand_in_sum.
qed

lemma disjoint_from_sum: "\<not> O z (x \<oplus> y) \<longleftrightarrow> \<not> O z x \<and> \<not> O z y"
proof -
  from sum_character have "O z (x \<oplus> y) \<longleftrightarrow> (O z x \<or> O z y)"..
  thus ?thesis by simp
qed

lemma summands_part_implies_sum_part:
  "P x z \<and> P y z \<Longrightarrow> P (x \<oplus> y) z"
proof -
  assume antecedent: "P x z \<and> P y z"
  have "\<forall> w. O w (x \<oplus> y) \<longrightarrow> O w z"
  proof
    fix w
    have w: "O w (x \<oplus> y) \<longleftrightarrow> (O w x \<or> O w y)"
      using sum_character..
    show "O w (x \<oplus> y) \<longrightarrow> O w z"
    proof
      assume "O w (x \<oplus> y)"
      with w have "O w x \<or> O w y"..
      thus "O w z"
      proof
        from antecedent have "P x z"..
        moreover assume "O w x"
        ultimately show "O w z"
          by (rule overlap_monotonicity)
      next
        from antecedent have "P y z"..
        moreover assume "O w y"
        ultimately show "O w z"
          by (rule overlap_monotonicity)
      qed
    qed
  qed
  with part_overlap_eq show "P (x \<oplus> y) z"..
qed

lemma sum_part_implies_summands_part:
  "P (x \<oplus> y) z \<Longrightarrow> P x z \<and> P y z"
proof -
  assume antecedent: "P (x \<oplus> y) z"
  show "P x z \<and> P y z"
  proof
    from first_summand_in_sum show "P x z"
      using antecedent by (rule part_transitivity)
  next
    from second_summand_in_sum show "P y z"
      using antecedent by (rule part_transitivity)
  qed
qed

lemma in_second_summand: "P z (x \<oplus> y) \<and> \<not> O z x \<Longrightarrow> P z y"
proof -
  assume antecedent: "P z (x \<oplus> y) \<and> \<not> O z x"
  hence "P z (x \<oplus> y)"..
  show "P z y"
  proof (rule ccontr)
    assume "\<not> P z y"
    hence "\<exists> v. P v z \<and> \<not> O v y"
      by (rule strong_supplementation)
    then obtain v where v: "P v z \<and> \<not> O v y"..
    hence "\<not> O v y"..
    from v have "P v z"..
    hence "P v (x \<oplus> y)"
      using \<open>P z (x \<oplus> y)\<close> by (rule part_transitivity)
    hence "O v (x \<oplus> y)" by (rule part_implies_overlap)
    from sum_character have "O v (x \<oplus> y) \<longleftrightarrow> O v x \<or> O v y"..
    hence "O v x \<or> O v y" using \<open>O v (x \<oplus> y)\<close>..
    thus "False"
    proof (rule disjE)
      from antecedent have "\<not> O z x"..
      moreover assume "O v x"
      hence "O x v" by (rule overlap_symmetry)
      with \<open>P v z\<close> have "O x z"
        by (rule overlap_monotonicity)
      hence "O z x" by (rule overlap_symmetry)
      ultimately show "False"..
    next
      assume "O v y"
      with \<open>\<not> O v y\<close> show "False"..
    qed
  qed
qed

lemma disjoint_second_summands:
  "P v (x \<oplus> y) \<and> P v (x \<oplus> z) \<Longrightarrow> \<not> O y z \<Longrightarrow> P v x"
proof -
  assume antecedent: "P v (x \<oplus> y) \<and> P v (x \<oplus> z)"
  hence "P v (x \<oplus> z)"..
  assume "\<not> O y z"
  show "P v x"
  proof (rule ccontr)
    assume "\<not> P v x"
    hence "\<exists> w. P w v \<and> \<not> O w x" by (rule strong_supplementation)
    then obtain w where w: "P w v \<and> \<not> O w x"..
    hence "\<not> O w x"..
    from w have "P w v"..
    moreover from antecedent have "P v (x \<oplus> z)"..
    ultimately have "P w (x \<oplus> z)" by (rule part_transitivity)
    hence "P w (x \<oplus> z) \<and> \<not> O w x" using \<open>\<not> O w x\<close>..
    hence "P w z" by (rule in_second_summand)
    from antecedent have "P v (x \<oplus> y)"..
    with \<open>P w v\<close> have "P w (x \<oplus> y)" by (rule part_transitivity)
    hence "P w (x \<oplus> y) \<and> \<not> O w x" using \<open>\<not> O w x\<close>..
    hence "P w y" by (rule in_second_summand)
    hence "P w y \<and> P w z" using \<open>P w z\<close>..
    hence "\<exists> w. P w y \<and> P w z"..
    with overlap_eq have "O y z"..
    with \<open>\<not> O y z\<close> show "False"..
  qed
qed

lemma right_associated_sum:
  "O w (x \<oplus> (y \<oplus> z)) \<longleftrightarrow> O w x \<or> (O w y \<or> O w z)"
proof -
  from sum_character have "O w (y \<oplus> z) \<longleftrightarrow> O w y \<or> O w z"..
  moreover from sum_character have
    "O w (x \<oplus> (y \<oplus> z)) \<longleftrightarrow> (O w x \<or> O w (y \<oplus> z))"..
  ultimately show ?thesis
    by (rule subst)
qed

lemma left_associated_sum:
  "O w ((x \<oplus> y) \<oplus> z) \<longleftrightarrow> (O w x \<or> O w y) \<or> O w z"
proof -
  from sum_character have "O w (x \<oplus> y) \<longleftrightarrow> (O w x \<or> O w y)"..
  moreover from sum_character have
    "O w ((x \<oplus> y) \<oplus> z) \<longleftrightarrow> O w (x \<oplus> y) \<or> O w z"..
  ultimately show ?thesis
    by (rule subst)
qed

theorem sum_associativity: "x \<oplus> (y \<oplus> z) = (x \<oplus> y) \<oplus> z"
proof -
  have  "\<forall> w. O w (x \<oplus> (y \<oplus> z)) \<longleftrightarrow> O w ((x \<oplus> y) \<oplus> z)"
  proof
    fix w
    have "O w (x \<oplus> (y \<oplus> z)) \<longleftrightarrow> (O w x \<or> O w y) \<or> O w z"
      using right_associated_sum by simp
    with left_associated_sum show
      "O w (x \<oplus> (y \<oplus> z)) \<longleftrightarrow> O w ((x \<oplus> y) \<oplus> z)" by (rule ssubst)
  qed
  with overlap_extensionality show "x \<oplus> (y \<oplus> z) = (x \<oplus> y) \<oplus> z"..
qed

subsection \<open> Distributivity \<close>

text \<open> The proofs in this section are adapted from \<^cite>\<open>"pietruszczak_metamereology_2018"\<close> pp. 102-4.  \<close>

lemma common_summand_in_product: "P x ((x \<oplus> y) \<otimes> (x \<oplus> z))"
    using common_first_summand by (rule common_part_in_product)

lemma product_in_first_summand:
  "\<not> O y z \<Longrightarrow> P ((x \<oplus> y) \<otimes> (x \<oplus> z)) x"
proof -
  assume "\<not> O y z"
  have "\<forall> v. P v ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<longrightarrow> P v x"
  proof
    fix v
    show "P v ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<longrightarrow> P v x"
    proof
      assume "P v ((x \<oplus> y) \<otimes> (x \<oplus> z))"
      with common_first_summand_overlap have
        "P v (x \<oplus> y) \<and> P v (x \<oplus> z)" by (rule product_part_in_factors)
      thus "P v x" using \<open>\<not> O y z\<close>  by (rule disjoint_second_summands)
    qed
  qed
  hence "P ((x \<oplus> y) \<otimes> (x \<oplus> z)) ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<longrightarrow>
    P ((x \<oplus> y) \<otimes> (x \<oplus> z)) x"..
  thus "P ((x \<oplus> y) \<otimes> (x \<oplus> z)) x" using part_reflexivity..
qed

lemma product_is_first_summand:
  "\<not> O y z \<Longrightarrow> (x \<oplus> y) \<otimes> (x \<oplus> z) = x"
proof -
  assume "\<not> O y z"
  hence "P ((x \<oplus> y) \<otimes> (x \<oplus> z)) x"
    by (rule product_in_first_summand)
  thus "(x \<oplus> y) \<otimes> (x \<oplus> z) = x"
    using common_summand_in_product
    by (rule part_antisymmetry)
qed

lemma sum_over_product_left: "O y z \<Longrightarrow> P (x \<oplus> (y \<otimes> z)) ((x \<oplus> y) \<otimes> (x \<oplus> z))"
proof -
  assume "O y z"
  hence "P (y \<otimes> z) ((x \<oplus> y) \<otimes> (x \<oplus> z))" using second_summands_in_sums
    by (rule part_product_in_whole_product)
  with common_summand_in_product have
    "P x ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<and> P (y \<otimes> z) ((x \<oplus> y) \<otimes> (x \<oplus> z))"..
  thus "P (x \<oplus> (y \<otimes> z)) ((x \<oplus> y) \<otimes> (x \<oplus> z))"
    by (rule summands_part_implies_sum_part)
qed

lemma sum_over_product_right:
  "O y z \<Longrightarrow> P ((x \<oplus> y) \<otimes> (x \<oplus> z)) (x \<oplus> (y \<otimes> z))"
proof -
  assume "O y z"
  show "P ((x \<oplus> y) \<otimes> (x \<oplus> z)) (x \<oplus> (y \<otimes> z))"
  proof (rule ccontr)
    assume "\<not> P ((x \<oplus> y) \<otimes> (x \<oplus> z)) (x \<oplus> (y \<otimes> z))"
    hence "\<exists> v. P v ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<and> \<not> O v (x \<oplus> (y \<otimes> z))"
      by (rule strong_supplementation)
    then obtain v where v:
      "P v ((x \<oplus> y) \<otimes> (x \<oplus> z)) \<and> \<not> O v (x \<oplus> (y \<otimes> z))"..
    hence " \<not> O v (x \<oplus> (y \<otimes> z))"..
    with disjoint_from_sum have vd: "\<not> O v x \<and> \<not> O v (y \<otimes> z)"..
    hence "\<not> O v (y \<otimes> z)"..
    from vd have "\<not> O v x"..
    from v have "P v ((x \<oplus> y) \<otimes> (x \<oplus> z))"..
    with common_first_summand_overlap have
      vs: "P v (x \<oplus> y) \<and> P v (x \<oplus> z)" by (rule product_part_in_factors)
    hence "P v (x \<oplus> y)"..
    hence "P v (x \<oplus> y) \<and> \<not> O v x" using \<open>\<not> O v x\<close>..
    hence "P v y" by (rule in_second_summand)
    moreover from vs have "P v (x \<oplus> z)"..
    hence "P v (x \<oplus> z) \<and> \<not> O v x" using \<open>\<not> O v x\<close>..
    hence "P v z" by (rule in_second_summand)
    ultimately have "P v y \<and> P v z"..
    hence "P v (y \<otimes> z)" by (rule common_part_in_product)
    hence "O v (y \<otimes> z)" by (rule part_implies_overlap)
    with \<open>\<not> O v (y \<otimes> z)\<close> show "False"..
  qed
qed

text \<open> Sums distribute over products. \<close>

theorem sum_over_product:
    "O y z \<Longrightarrow> x \<oplus> (y \<otimes> z) = (x \<oplus> y) \<otimes> (x \<oplus> z)"
proof -
  assume "O y z"
  hence "P (x \<oplus> (y \<otimes> z)) ((x \<oplus> y) \<otimes> (x \<oplus> z))"
    by (rule sum_over_product_left)
  moreover have "P ((x \<oplus> y) \<otimes> (x \<oplus> z)) (x \<oplus> (y \<otimes> z))"
    using \<open>O y z\<close> by (rule sum_over_product_right)
  ultimately show "x \<oplus> (y \<otimes> z) = (x \<oplus> y) \<otimes> (x \<oplus> z)"
    by (rule part_antisymmetry)
qed

lemma product_in_factor_by_sum:
  "O x y \<Longrightarrow> P (x \<otimes> y) (x \<otimes> (y \<oplus> z))"
proof -
  assume "O x y"
  hence "P (x \<otimes> y) x"
    by (rule product_in_first_factor)
  moreover have "P (x \<otimes> y) y"
    using \<open>O x y\<close> by (rule product_in_second_factor)
  hence "P (x \<otimes> y) (y \<oplus> z)"
    using first_summand_in_sum by (rule part_transitivity)
  with \<open>P (x \<otimes> y) x\<close> have "P (x \<otimes> y) x \<and> P (x \<otimes> y) (y \<oplus> z)"..
  thus "P (x \<otimes> y) (x \<otimes> (y \<oplus> z))"
    by (rule common_part_in_product)
qed

lemma product_of_first_summand:
  "O x y \<Longrightarrow> \<not> O x z \<Longrightarrow> P (x \<otimes> (y \<oplus> z)) (x \<otimes> y)"
proof -
  assume "O x y"
  hence "O x (y \<oplus> z)"
    by (rule first_summand_overlap)
  assume "\<not> O x z"
  show "P (x \<otimes> (y \<oplus> z)) (x \<otimes> y)"
  proof (rule ccontr)
    assume "\<not> P (x \<otimes> (y \<oplus> z)) (x \<otimes> y)"
    hence "\<exists> v. P v (x \<otimes> (y \<oplus> z)) \<and> \<not> O v (x \<otimes> y)"
      by (rule strong_supplementation)
    then obtain v where v: "P v (x \<otimes> (y \<oplus> z)) \<and> \<not> O v (x \<otimes> y)"..
    hence "P v (x \<otimes> (y \<oplus> z))"..
    with \<open>O x (y \<oplus> z)\<close> have "P v x \<and> P v (y \<oplus> z)"
      by (rule product_part_in_factors)
    hence "P v x"..
    moreover from v have "\<not> O v (x \<otimes> y)"..
    ultimately have  "P v x \<and> \<not> O v (x \<otimes> y)"..
    hence "\<not> O v y" by (rule disjoint_from_second_factor)
    from \<open>P v x \<and> P v (y \<oplus> z)\<close> have "P v (y \<oplus> z)"..
    hence "P v (y \<oplus> z) \<and> \<not> O v y" using \<open>\<not> O v y\<close>..
    hence "P v z" by (rule in_second_summand)
    with \<open>P v x\<close> have "P v x \<and> P v z"..
    hence "\<exists> v. P v x \<and> P v z"..
    with overlap_eq have "O x z"..
    with \<open>\<not> O x z\<close> show "False"..
  qed
qed

theorem disjoint_product_over_sum:
  "O x y \<Longrightarrow> \<not> O x z \<Longrightarrow> x \<otimes> (y \<oplus> z) = x \<otimes> y"
proof -
  assume "O x y"
  moreover assume "\<not> O x z"
  ultimately have "P (x \<otimes> (y \<oplus> z)) (x \<otimes> y)"
    by (rule product_of_first_summand)
  moreover have "P (x \<otimes> y)(x \<otimes> (y \<oplus> z))"
    using \<open>O x y\<close> by (rule product_in_factor_by_sum)
  ultimately show "x \<otimes> (y \<oplus> z) = x \<otimes> y"
    by (rule part_antisymmetry)
qed

lemma product_over_sum_left:
  "O x y \<and> O x z \<Longrightarrow> P (x \<otimes> (y \<oplus> z))((x \<otimes> y) \<oplus> (x \<otimes> z))"
proof -
  assume "O x y \<and> O x z"
  hence "O x y"..
  hence "O x (y \<oplus> z)" by (rule first_summand_overlap)
  show "P (x \<otimes> (y \<oplus> z))((x \<otimes> y) \<oplus> (x \<otimes> z))"
  proof (rule ccontr)
    assume "\<not> P (x \<otimes> (y \<oplus> z))((x \<otimes> y) \<oplus> (x \<otimes> z))"
    hence "\<exists> v. P v (x \<otimes> (y \<oplus> z)) \<and> \<not> O v ((x \<otimes> y) \<oplus> (x \<otimes> z))"
      by (rule strong_supplementation)
    then obtain v where v:
      "P v (x \<otimes> (y \<oplus> z)) \<and> \<not> O v ((x \<otimes> y) \<oplus> (x \<otimes> z))"..
    hence "\<not> O v ((x \<otimes> y) \<oplus> (x \<otimes> z))"..
    with disjoint_from_sum have oxyz:
      "\<not> O v (x \<otimes> y) \<and> \<not> O v (x \<otimes> z)"..
    from v have "P v (x \<otimes> (y \<oplus> z))"..
    with \<open>O x (y \<oplus> z)\<close> have pxyz: "P v x \<and> P v (y \<oplus> z)"
      by (rule product_part_in_factors)
    hence "P v x"..
    moreover from oxyz have "\<not> O v (x \<otimes> y)"..
    ultimately have "P v x \<and> \<not> O v (x \<otimes> y)"..
    hence "\<not> O v y" by (rule disjoint_from_second_factor)
    from oxyz have "\<not> O v (x \<otimes> z)"..
    with \<open>P v x\<close> have "P v x \<and> \<not> O v (x \<otimes> z)"..
    hence "\<not> O v z" by (rule disjoint_from_second_factor)
    with \<open>\<not> O v y\<close> have "\<not> O v y \<and> \<not> O v z"..
    with disjoint_from_sum have "\<not> O v (y \<oplus> z)"..
    from pxyz have "P v (y \<oplus> z)"..
    hence "O v (y \<oplus> z)" by (rule part_implies_overlap)
    with \<open>\<not> O v (y \<oplus> z)\<close> show "False"..
  qed
qed

lemma product_over_sum_right:
  "O x y \<and> O x z \<Longrightarrow> P((x \<otimes> y) \<oplus> (x \<otimes> z))(x \<otimes> (y \<oplus> z))"
proof -
  assume antecedent: "O x y \<and> O x z"
  have "P (x \<otimes> y) (x \<otimes> (y \<oplus> z)) \<and> P (x \<otimes> z) (x \<otimes> (y \<oplus> z))"
  proof
    from antecedent have "O x y"..
    thus "P (x \<otimes> y) (x \<otimes> (y \<oplus> z))"
      by (rule  product_in_factor_by_sum)
  next
    from antecedent have "O x z"..
    hence "P (x \<otimes> z) (x \<otimes> (z \<oplus> y))"
      by (rule  product_in_factor_by_sum)
    with sum_commutativity show "P (x \<otimes> z) (x \<otimes> (y \<oplus> z))"
      by (rule subst)
  qed
  thus "P((x \<otimes> y) \<oplus> (x \<otimes> z))(x \<otimes> (y \<oplus> z))"
    by (rule summands_part_implies_sum_part)
qed

theorem product_over_sum:
  "O x y \<and> O x z \<Longrightarrow> x \<otimes> (y \<oplus> z) = (x \<otimes> y) \<oplus> (x \<otimes> z)"
proof -
  assume antecedent: "O x y \<and> O x z"
  hence "P (x \<otimes> (y \<oplus> z))((x \<otimes> y) \<oplus> (x \<otimes> z))"
    by (rule product_over_sum_left)
  moreover have "P((x \<otimes> y) \<oplus> (x \<otimes> z))(x \<otimes> (y \<oplus> z))"
    using antecedent by (rule product_over_sum_right)
  ultimately show "x \<otimes> (y \<oplus> z) = (x \<otimes> y) \<oplus> (x \<otimes> z)"
    by (rule part_antisymmetry)
qed

lemma joint_identical_sums:
  "v \<oplus> w = x \<oplus> y \<Longrightarrow> O x v \<and> O x w \<Longrightarrow> ((x \<otimes> v) \<oplus> (x \<otimes> w)) = x"
proof -
  assume "v \<oplus> w = x \<oplus> y"
  moreover assume "O x v \<and> O x w"
  hence "x \<otimes> (v \<oplus> w) = x \<otimes> v \<oplus> x \<otimes> w"
    by (rule product_over_sum)
  ultimately have "x \<otimes> (x \<oplus> y) = x \<otimes> v \<oplus> x \<otimes> w" by (rule subst)
  moreover have "(x \<otimes> (x \<oplus> y)) = x" using first_summand_in_sum
    by (rule part_product_identity)
  ultimately show "((x \<otimes> v) \<oplus> (x \<otimes> w)) = x" by (rule subst)
qed

lemma disjoint_identical_sums:
  "v \<oplus> w = x \<oplus> y \<Longrightarrow> \<not> O y v \<and> \<not> O w x \<Longrightarrow> x = v \<and> y = w"
proof -
  assume identical: "v \<oplus> w = x \<oplus> y"
  assume disjoint: "\<not> O y v \<and> \<not> O w x"
  show "x = v \<and> y = w"
  proof
    from disjoint have "\<not> O y v"..
    hence "(x \<oplus> y) \<otimes> (x \<oplus> v) = x"
      by (rule product_is_first_summand)
    with identical have "(v \<oplus> w) \<otimes> (x \<oplus> v) = x"
      by (rule ssubst)
    moreover from disjoint have "\<not> O w x"..
    hence "(v \<oplus> w) \<otimes> (v \<oplus> x) = v"
      by (rule product_is_first_summand)
    with sum_commutativity have "(v \<oplus> w) \<otimes> (x \<oplus> v) = v"
      by (rule subst)
    ultimately show "x = v" by (rule subst)
  next
    from disjoint have "\<not> O w x"..
    hence "(y \<oplus> w) \<otimes> (y \<oplus> x) = y"
      by (rule product_is_first_summand)
    moreover from disjoint have "\<not> O y v"..
    hence "(w \<oplus> y) \<otimes> (w \<oplus> v) = w"
      by (rule product_is_first_summand)
    with sum_commutativity have "(w \<oplus> y) \<otimes> (v \<oplus> w) = w"
      by (rule subst)
    with identical have "(w \<oplus> y) \<otimes> (x \<oplus> y) = w"
      by (rule subst)
    with sum_commutativity have "(w \<oplus> y) \<otimes> (y \<oplus> x) = w"
      by (rule subst)
    with sum_commutativity have "(y \<oplus> w) \<otimes> (y \<oplus> x) = w"
      by (rule subst)
    ultimately show "y = w"
      by (rule subst)
  qed
qed

end

subsection \<open> Differences \<close>

locale CEMD = CEM + CMD
begin

lemma plus_minus: "PP y x \<Longrightarrow> y \<oplus> (x \<ominus> y) = x"
proof -
  assume "PP y x"
  hence "\<exists> z. P z x \<and> \<not> O z y" by (rule weak_supplementation)
  hence xmy:"\<forall> w. P w (x \<ominus> y) \<longleftrightarrow> (P w x \<and> \<not> O w y)"
    by (rule difference_character)
  have "\<forall> w. O w x \<longleftrightarrow> (O w y \<or> O w (x \<ominus> y))"
  proof
    fix w
    from xmy have w: "P w (x \<ominus> y) \<longleftrightarrow> (P w x \<and> \<not> O w y)"..
    show "O w x \<longleftrightarrow> (O w y \<or> O w (x \<ominus> y))"
    proof
      assume "O w x"
      with overlap_eq have "\<exists> v. P v w \<and> P v x"..
      then obtain v where v: "P v w \<and> P v x"..
      hence "P v w"..
      from v have "P v x"..
      show "O w y \<or> O w (x \<ominus> y)"
      proof cases
        assume "O v y"
        hence "O y v" by (rule overlap_symmetry)
        with \<open>P v w\<close> have "O y w" by (rule overlap_monotonicity)
        hence "O w y" by (rule overlap_symmetry)
        thus "O w y \<or> O w (x \<ominus> y)"..
      next
        from xmy have "P v (x \<ominus> y) \<longleftrightarrow> (P v x \<and> \<not> O v y)"..
        moreover assume "\<not> O v y"
        with \<open>P v x\<close> have  "P v x \<and> \<not> O v y"..
        ultimately have "P v (x \<ominus> y)"..
        with \<open>P v w\<close> have "P v w \<and> P v (x \<ominus> y)"..
        hence "\<exists> v. P v w \<and> P v (x \<ominus> y)"..
        with overlap_eq have "O w (x \<ominus> y)"..
        thus "O w y \<or> O w (x \<ominus> y)"..
      qed
    next
      assume "O w y \<or> O w (x \<ominus> y)"
      thus "O w x"
      proof
        from \<open>PP y x\<close> have "P y x"
          by (rule proper_implies_part)
        moreover assume "O w y"
        ultimately show "O w x"
          by (rule overlap_monotonicity)
      next
        assume "O w (x \<ominus> y)"
        with overlap_eq have "\<exists> v. P v w \<and> P v (x \<ominus> y)"..
        then obtain v where v: "P v w \<and> P v (x \<ominus> y)"..
        hence "P v w"..
        from xmy have "P v (x \<ominus> y) \<longleftrightarrow> (P v x \<and> \<not> O v y)"..
        moreover from v have "P v (x \<ominus> y)"..
        ultimately have "P v x \<and> \<not> O v y"..
        hence "P v x"..
        with \<open>P v w\<close> have "P v w \<and> P v x"..
        hence "\<exists> v. P v w \<and> P v x"..
        with overlap_eq show "O w x"..
      qed
    qed
  qed
  thus "y \<oplus> (x \<ominus> y) = x"
    by (rule sum_intro)
qed

end

subsection \<open> The Universe \<close>

locale CEMU = CEM + CMU
begin

lemma something_disjoint: "x \<noteq> u \<Longrightarrow> (\<exists> v. \<not> O v x)"
proof -
  assume "x \<noteq> u"
  with universe_character have "P x u \<and> x \<noteq> u"..
  with nip_eq have "PP x u"..
  hence "\<exists> v. P v u \<and> \<not> O v x"
    by (rule weak_supplementation)
  then obtain v where "P v u \<and> \<not> O v x"..
  hence "\<not> O v x"..
  thus "\<exists> v. \<not> O v x"..
qed

lemma overlaps_universe: "O x u"
proof -
  from universe_character have "P x u".
  thus "O x u" by (rule part_implies_overlap)
qed

lemma universe_absorbing: "x \<oplus> u = u"
proof -
  from universe_character have "P (x \<oplus> u) u".
  thus "x \<oplus> u = u" using second_summand_in_sum
    by (rule part_antisymmetry)
qed

lemma second_summand_not_universe: "x \<oplus> y \<noteq> u \<Longrightarrow> y \<noteq> u"
proof -
  assume antecedent: "x \<oplus> y \<noteq> u"
  show "y \<noteq> u"
  proof
    assume "y = u"
    hence "x \<oplus> u \<noteq> u" using antecedent by (rule subst)
    thus "False" using universe_absorbing..
  qed
qed

lemma first_summand_not_universe: "x \<oplus> y \<noteq> u \<Longrightarrow> x \<noteq> u"
proof -
  assume "x \<oplus> y \<noteq> u"
  with sum_commutativity have "y \<oplus> x \<noteq> u" by (rule subst)
  thus "x \<noteq> u" by (rule second_summand_not_universe)
qed

end

subsection \<open> Complements \<close>

locale CEMC = CEM + CMC +
  assumes universe_eq: "u = (THE x. \<forall> y. P y x)"
begin

lemma complement_sum_character: "\<forall> y. P y (x \<oplus> (\<midarrow>x))"
proof
  fix y
  have "\<forall> v. O v y \<longrightarrow> O v x \<or> O v (\<midarrow>x)"
  proof
    fix v
    show "O v y \<longrightarrow> O v x \<or> O v (\<midarrow>x)"
    proof
      assume "O v y"
      show "O v x \<or> O v (\<midarrow>x)"
        using or_complement_overlap..
    qed
  qed
  with sum_part_character show "P y (x \<oplus> (\<midarrow>x))"..
qed

lemma universe_closure: "\<exists> x. \<forall> y. P y x"
  using complement_sum_character by (rule exI)

end

sublocale CEMC \<subseteq> CEMU
proof
  show "u = (THE z. \<forall>w. P w z)" using universe_eq.
  show "\<exists> x. \<forall> y. P y x" using universe_closure.
qed

sublocale CEMC \<subseteq> CEMD
proof
qed

context CEMC
begin

corollary universe_is_complement_sum: "u = x \<oplus> (\<midarrow>x)"
  using complement_sum_character by (rule universe_intro)

lemma strong_complement_character:
  "x \<noteq> u \<Longrightarrow> (\<forall> v. P v (\<midarrow>x) \<longleftrightarrow> \<not> O v x)"
proof -
  assume "x \<noteq> u"
  hence "\<exists> v. \<not> O v x" by (rule something_disjoint)
  thus "\<forall> v. P v (\<midarrow>x) \<longleftrightarrow> \<not> O v x" by (rule complement_character)
qed

lemma complement_part_not_part: "x \<noteq> u \<Longrightarrow> P y (\<midarrow>x) \<Longrightarrow> \<not> P y x"
proof -
  assume "x \<noteq> u"
  hence "\<forall> w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    by (rule strong_complement_character)
  hence y: "P y (\<midarrow>x) \<longleftrightarrow> \<not> O y x"..
  moreover assume "P y (\<midarrow>x)"
  ultimately have "\<not> O y x"..
  thus "\<not> P y x"
    by (rule disjoint_implies_not_part)
qed

lemma complement_involution: "x \<noteq> u \<Longrightarrow> x = \<midarrow>(\<midarrow>x)"
proof -
  assume "x \<noteq> u"
  have "\<not> P u x"
  proof
    assume "P u x"
    with universe_character have "x = u"
      by (rule part_antisymmetry)
    with \<open>x \<noteq> u\<close> show "False"..
  qed
  hence "\<exists> v. P v u \<and> \<not> O v x"
    by (rule strong_supplementation)
  then obtain v where v: "P v u \<and> \<not> O v x"..
  hence "\<not> O v x"..
  hence "\<exists> v. \<not> O v x"..
  hence notx: "\<forall> w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    by (rule complement_character)
  have "\<midarrow>x \<noteq> u"
  proof
    assume "\<midarrow>x = u"
    hence "\<forall> w. P w u \<longleftrightarrow> \<not> O w x" using notx by (rule subst)
    hence "P x u \<longleftrightarrow> \<not> O x x"..
    hence "\<not> O x x" using universe_character..
    thus "False" using overlap_reflexivity..
  qed
  have "\<not> P u (\<midarrow>x)"
  proof
    assume "P u (\<midarrow>x)"
    with universe_character have "\<midarrow>x = u"
      by (rule part_antisymmetry)
    with \<open>\<midarrow>x \<noteq> u\<close> show "False"..
  qed
  hence "\<exists> v. P v u \<and> \<not> O v (\<midarrow>x)"
    by (rule strong_supplementation)
  then obtain w where w: "P w u \<and> \<not> O w (\<midarrow>x)"..
  hence "\<not> O w (\<midarrow>x)"..
  hence "\<exists> v. \<not> O v (\<midarrow>x)"..
  hence notnotx: "\<forall> w. P w (\<midarrow>(\<midarrow>x)) \<longleftrightarrow> \<not> O w (\<midarrow>x)"
    by (rule complement_character)
  hence "P x (\<midarrow>(\<midarrow>x)) \<longleftrightarrow> \<not> O x (\<midarrow>x)"..
  moreover have "\<not> O x (\<midarrow>x)"
  proof
    assume "O x (\<midarrow>x)"
    with overlap_eq have "\<exists> s. P s x \<and> P s (\<midarrow>x)"..
    then obtain s where s: "P s x \<and> P s (\<midarrow>x)"..
    hence "P s x"..
    hence "O s x" by (rule part_implies_overlap)
    from notx have "P s (\<midarrow>x) \<longleftrightarrow> \<not> O s x"..
    moreover from s have "P s (\<midarrow>x)"..
    ultimately have "\<not> O s x"..
    thus "False" using \<open>O s x\<close>..
  qed
  ultimately have "P x (\<midarrow>(\<midarrow>x))"..
  moreover have "P (\<midarrow>(\<midarrow>x)) x"
  proof (rule ccontr)
    assume "\<not> P (\<midarrow>(\<midarrow>x)) x"
    hence "\<exists> s. P s (\<midarrow>(\<midarrow>x)) \<and> \<not> O s x"
      by (rule strong_supplementation)
    then obtain s where s: "P s (\<midarrow>(\<midarrow>x)) \<and> \<not> O s x"..
    hence "\<not> O s x"..
    from notnotx have "P s (\<midarrow>(\<midarrow>x)) \<longleftrightarrow> (\<not> O s (\<midarrow>x))"..
    moreover from s have "P s (\<midarrow>(\<midarrow>x))"..
    ultimately have "\<not> O s (\<midarrow>x)"..
    from or_complement_overlap have "O s x \<or> O s (\<midarrow>x)"..
    thus "False"
    proof
      assume "O s x"
      with \<open>\<not> O s x\<close> show "False"..
    next
      assume "O s (\<midarrow>x)"
      with \<open>\<not> O s (\<midarrow>x )\<close> show "False"..
    qed
  qed
  ultimately show "x = \<midarrow>(\<midarrow>x)"
    by (rule part_antisymmetry)
qed

lemma part_complement_reversal: "y \<noteq> u \<Longrightarrow> P x y \<Longrightarrow> P (\<midarrow>y) (\<midarrow>x)"
proof -
  assume "y \<noteq> u"
  hence ny: "\<forall> w. P w (\<midarrow>y) \<longleftrightarrow> \<not> O w y"
    by (rule strong_complement_character)
  assume "P x y"
  have "x \<noteq> u"
  proof
    assume "x = u"
    hence "P u y" using \<open>P x y\<close> by (rule subst)
    with universe_character have "y = u"
      by (rule part_antisymmetry)
    with \<open>y \<noteq> u\<close> show "False"..
  qed
  hence "\<forall> w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
    by (rule strong_complement_character)
  hence "P (\<midarrow>y) (\<midarrow>x) \<longleftrightarrow> \<not> O (\<midarrow>y) x"..
  moreover have "\<not> O (\<midarrow>y) x"
  proof
    assume "O (\<midarrow>y) x"
    with overlap_eq have "\<exists> v. P v (\<midarrow>y) \<and> P v x"..
    then obtain v where v: "P v (\<midarrow>y) \<and> P v x"..
    hence "P v (\<midarrow>y)"..
    from ny have "P v (\<midarrow>y) \<longleftrightarrow> \<not> O v y"..
    hence "\<not> O v y" using \<open>P v (\<midarrow>y)\<close>..
    moreover from v have "P v x"..
    hence "P v y" using \<open>P x y\<close>
      by (rule part_transitivity)
    hence "O v y"
      by (rule part_implies_overlap)
    ultimately show "False"..
  qed
  ultimately show "P (\<midarrow>y) (\<midarrow>x)"..
qed

lemma complements_overlap: "x \<oplus> y \<noteq> u \<Longrightarrow> O(\<midarrow>x)(\<midarrow>y)"
proof -
  assume "x \<oplus> y \<noteq> u"
  hence "\<exists> z. \<not> O z (x \<oplus> y)"
    by (rule something_disjoint)
  then obtain z where z:"\<not> O z (x \<oplus> y)"..
  hence "\<not> O z x" by (rule first_summand_disjointness)
  hence "P z (\<midarrow>x)" by (rule complement_part)
  moreover from z have "\<not> O z y"
    by (rule second_summand_disjointness)
  hence "P z (\<midarrow>y)" by (rule complement_part)
  ultimately show "O(\<midarrow>x)(\<midarrow>y)"
    by (rule overlap_intro)
qed

lemma sum_complement_in_complement_product:
  "x \<oplus> y \<noteq> u \<Longrightarrow> P(\<midarrow>(x \<oplus> y))(\<midarrow>x \<otimes> \<midarrow>y)"
proof -
  assume "x \<oplus> y \<noteq> u"
  hence "O (\<midarrow>x) (\<midarrow>y)"
    by (rule complements_overlap)
  hence "\<forall> w. P w (\<midarrow>x \<otimes> \<midarrow>y) \<longleftrightarrow> (P w (\<midarrow>x) \<and> P w (\<midarrow>y))"
    by (rule product_character)
  hence "P(\<midarrow>(x \<oplus> y))(\<midarrow>x \<otimes> \<midarrow>y)\<longleftrightarrow>(P(\<midarrow>(x \<oplus> y))(\<midarrow>x) \<and> P(\<midarrow>(x \<oplus> y))(\<midarrow>y))"..
  moreover have "P (\<midarrow>(x \<oplus> y))(\<midarrow>x) \<and> P (\<midarrow>(x \<oplus> y))(\<midarrow>y)"
  proof
    show "P (\<midarrow>(x \<oplus> y))(\<midarrow>x)" using \<open>x \<oplus> y \<noteq> u\<close> first_summand_in_sum
      by (rule part_complement_reversal)
  next
    show  "P (\<midarrow>(x \<oplus> y))(\<midarrow>y)" using \<open>x \<oplus> y \<noteq> u\<close> second_summand_in_sum
      by (rule part_complement_reversal)
  qed
  ultimately show "P (\<midarrow>(x \<oplus> y))(\<midarrow>x \<otimes> \<midarrow>y)"..
qed

lemma complement_product_in_sum_complement:
  "x \<oplus> y \<noteq> u \<Longrightarrow> P(\<midarrow>x \<otimes> \<midarrow>y)(\<midarrow>(x \<oplus> y))"
proof -
  assume "x \<oplus> y \<noteq> u"
  hence "\<forall>w. P w (\<midarrow>(x \<oplus> y)) \<longleftrightarrow> \<not> O w (x \<oplus> y)"
    by (rule strong_complement_character)
  hence "P (\<midarrow>x \<otimes> \<midarrow>y) (\<midarrow>(x \<oplus> y)) \<longleftrightarrow> (\<not> O (\<midarrow>x \<otimes> \<midarrow>y) (x \<oplus> y))"..
  moreover have "\<not> O (\<midarrow>x \<otimes> \<midarrow>y) (x \<oplus> y)"
  proof
    have "O(\<midarrow>x)(\<midarrow>y)" using \<open>x \<oplus> y \<noteq> u\<close> by (rule complements_overlap)
    hence p: "\<forall> v. P v ((\<midarrow>x) \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P v (\<midarrow>x) \<and> P v (\<midarrow>y))"
      by (rule product_character)
    have "O(\<midarrow>x \<otimes> \<midarrow>y)(x \<oplus> y) \<longleftrightarrow> (O(\<midarrow>x \<otimes> \<midarrow>y) x \<or> O(\<midarrow>x \<otimes> \<midarrow>y)y)"
      using sum_character..
    moreover assume "O (\<midarrow>x \<otimes> \<midarrow>y)(x \<oplus> y)"
    ultimately have "O (\<midarrow>x \<otimes> \<midarrow>y) x \<or> O (\<midarrow>x \<otimes> \<midarrow>y) y"..
    thus "False"
    proof
      assume "O (\<midarrow>x \<otimes> \<midarrow>y) x"
      with overlap_eq have "\<exists> v. P v (\<midarrow>x \<otimes> \<midarrow>y) \<and> P v x"..
      then obtain v where v: "P v (\<midarrow>x \<otimes> \<midarrow>y) \<and> P v x"..
      hence "P v (\<midarrow>x \<otimes> \<midarrow>y)"..
      from p have "P v ((\<midarrow>x) \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P v (\<midarrow>x) \<and> P v (\<midarrow>y))"..
      hence "P v (\<midarrow>x) \<and> P v (\<midarrow>y)" using \<open>P v (\<midarrow>x \<otimes> \<midarrow>y)\<close>..
      hence "P v (\<midarrow>x)"..
      have "x \<noteq> u" using \<open>x \<oplus> y \<noteq> u\<close>
        by (rule first_summand_not_universe)
      hence "\<forall>w. P w (\<midarrow>x) \<longleftrightarrow> \<not> O w x"
        by (rule strong_complement_character)
      hence "P v (\<midarrow>x) \<longleftrightarrow> \<not> O v x"..
      hence "\<not> O v x" using \<open>P v (\<midarrow>x)\<close>..
      moreover from v have "P v x"..
      hence "O v x" by (rule part_implies_overlap)
      ultimately show "False"..
    next
      assume "O (\<midarrow>x \<otimes> \<midarrow>y) y"
      with overlap_eq have "\<exists> v. P v (\<midarrow>x \<otimes> \<midarrow>y) \<and> P v y"..
      then obtain v where v: "P v (\<midarrow>x \<otimes> \<midarrow>y) \<and> P v y"..
      hence "P v (\<midarrow>x \<otimes> \<midarrow>y)"..
      from p have "P v ((\<midarrow>x) \<otimes> (\<midarrow>y)) \<longleftrightarrow> (P v (\<midarrow>x) \<and> P v (\<midarrow>y))"..
      hence "P v (\<midarrow>x) \<and> P v (\<midarrow>y)" using \<open>P v (\<midarrow>x \<otimes> \<midarrow>y)\<close>..
      hence "P v (\<midarrow>y)"..
      have "y \<noteq> u" using \<open>x \<oplus> y \<noteq> u\<close>
        by (rule second_summand_not_universe)
      hence "\<forall>w. P w (\<midarrow>y) \<longleftrightarrow> \<not> O w y"
        by (rule strong_complement_character)
      hence "P v (\<midarrow>y) \<longleftrightarrow> \<not> O v y"..
      hence "\<not> O v y" using \<open>P v (\<midarrow>y)\<close>..
      moreover from v have "P v y"..
      hence "O v y" by (rule part_implies_overlap)
      ultimately show "False"..
    qed
  qed
  ultimately show "P (\<midarrow>x \<otimes> \<midarrow>y) (\<midarrow>(x \<oplus> y))"..
qed

theorem sum_complement_is_complements_product:
  "x \<oplus> y \<noteq> u \<Longrightarrow> \<midarrow>(x \<oplus> y) = (\<midarrow>x \<otimes> \<midarrow>y)"
proof -
  assume "x \<oplus> y \<noteq> u"
  show "\<midarrow>(x \<oplus> y) = (\<midarrow>x \<otimes> \<midarrow>y)"
  proof (rule part_antisymmetry)
    show "P (\<midarrow> (x \<oplus> y)) (\<midarrow> x \<otimes> \<midarrow> y)" using  \<open>x \<oplus> y \<noteq> u\<close>
      by (rule sum_complement_in_complement_product)
    show "P (\<midarrow> x \<otimes> \<midarrow> y) (\<midarrow> (x \<oplus> y))" using \<open>x \<oplus> y \<noteq> u\<close>
      by (rule complement_product_in_sum_complement)
  qed
qed

lemma complement_sum_in_product_complement:
  "O x y \<Longrightarrow> x \<noteq> u \<Longrightarrow> y \<noteq> u \<Longrightarrow> P ((\<midarrow>x) \<oplus> (\<midarrow>y))(\<midarrow>(x \<otimes> y))"
proof -
  assume "O x y"
  assume "x \<noteq> u"
  assume "y \<noteq> u"
  have "x \<otimes> y \<noteq> u"
  proof
    assume "x \<otimes> y = u"
    with \<open>O x y\<close> have "x = u"
      by (rule product_universe_implies_factor_universe)
    with \<open>x \<noteq> u\<close> show "False"..
  qed
  hence notxty: "\<forall> w. P w (\<midarrow>(x \<otimes> y)) \<longleftrightarrow> \<not> O w (x \<otimes> y)"
    by (rule strong_complement_character)
  hence "P((\<midarrow>x)\<oplus>(\<midarrow>y))(\<midarrow>(x \<otimes> y)) \<longleftrightarrow> \<not>O((\<midarrow>x)\<oplus>(\<midarrow>y))(x \<otimes> y)"..
  moreover have "\<not> O ((\<midarrow>x) \<oplus> (\<midarrow>y)) (x \<otimes> y)"
  proof
    from sum_character have
      "\<forall> w. O w ((\<midarrow>x) \<oplus> (\<midarrow>y)) \<longleftrightarrow> (O w (\<midarrow>x) \<or> O w (\<midarrow>y))".
    hence "O(x \<otimes> y)((\<midarrow>x)\<oplus>(\<midarrow>y)) \<longleftrightarrow> (O(x \<otimes> y)(\<midarrow>x) \<or> O(x \<otimes> y)(\<midarrow>y))"..
    moreover assume "O ((\<midarrow>x) \<oplus> (\<midarrow>y)) (x \<otimes> y)"
    hence "O (x \<otimes> y) ((\<midarrow>x) \<oplus> (\<midarrow>y))" by (rule overlap_symmetry)
    ultimately have "O (x \<otimes> y) (\<midarrow>x) \<or> O (x \<otimes> y) (\<midarrow>y)"..
    thus False
    proof
      assume "O (x \<otimes> y)(\<midarrow>x)"
      with overlap_eq have "\<exists> v. P v (x \<otimes> y) \<and> P v (\<midarrow>x)"..
      then obtain v where v: "P v (x \<otimes> y) \<and> P v (\<midarrow>x)"..
      hence "P v (\<midarrow>x)"..
      with \<open>x \<noteq> u\<close> have "\<not> P v x"
        by (rule complement_part_not_part)
      moreover from v have "P v (x \<otimes> y)"..
      with \<open>O x y\<close> have "P v x" by (rule product_part_in_first_factor)
      ultimately show "False"..
    next
      assume "O (x \<otimes> y) (\<midarrow>y)"
      with overlap_eq have "\<exists> v. P v (x \<otimes> y) \<and> P v (\<midarrow>y)"..
      then obtain v where v: "P v (x \<otimes> y) \<and> P v (\<midarrow>y)"..
      hence "P v (\<midarrow>y)"..
      with \<open>y \<noteq> u\<close> have "\<not> P v y"
        by (rule complement_part_not_part)
      moreover from v have "P v (x \<otimes> y)"..
      with \<open>O x y\<close> have "P v y" by (rule product_part_in_second_factor)
      ultimately show "False"..
    qed
  qed
  ultimately show "P ((\<midarrow>x) \<oplus> (\<midarrow>y))(\<midarrow>(x \<otimes> y))"..
qed

lemma product_complement_in_complements_sum:
  "x \<noteq> u \<Longrightarrow> y \<noteq> u \<Longrightarrow> P(\<midarrow>(x \<otimes> y))((\<midarrow>x) \<oplus> (\<midarrow>y))"
proof -
  assume "x \<noteq> u"
  hence "x = \<midarrow>(\<midarrow>x)"
    by (rule complement_involution)
  assume "y \<noteq> u"
  hence "y = \<midarrow>(\<midarrow>y)"
    by (rule complement_involution)
  show "P (\<midarrow>(x \<otimes> y))((\<midarrow>x) \<oplus> (\<midarrow>y))"
  proof cases
    assume "\<midarrow>x \<oplus> \<midarrow>y = u"
    thus "P (\<midarrow>(x \<otimes> y))((\<midarrow>x) \<oplus> (\<midarrow>y))"
      using universe_character by (rule ssubst)
  next
    assume "\<midarrow>x \<oplus> \<midarrow>y \<noteq> u"
    hence "\<midarrow>x \<oplus> \<midarrow>y = \<midarrow>(\<midarrow>(\<midarrow>x \<oplus> \<midarrow> y))"
      by (rule complement_involution)
    moreover have "\<midarrow>(\<midarrow>x \<oplus> \<midarrow>y) = \<midarrow>(\<midarrow>x) \<otimes> \<midarrow>(\<midarrow>y)"
      using \<open>\<midarrow>x \<oplus> \<midarrow>y \<noteq> u\<close>
      by (rule sum_complement_is_complements_product)
    with \<open>x = \<midarrow>(\<midarrow>x)\<close> have  "\<midarrow>(\<midarrow>x \<oplus> \<midarrow>y) = x \<otimes> \<midarrow>(\<midarrow>y)"
      by (rule ssubst)
    with \<open>y = \<midarrow>(\<midarrow>y)\<close> have  "\<midarrow>(\<midarrow>x \<oplus> \<midarrow>y) = x \<otimes> y"
      by (rule ssubst)
    hence "P (\<midarrow>(x \<otimes> y))(\<midarrow>(\<midarrow>(\<midarrow>x \<oplus> \<midarrow>y)))"
      using part_reflexivity by (rule subst)
    ultimately show "P (\<midarrow>(x \<otimes> y))(\<midarrow>x \<oplus> \<midarrow>y)"
      by (rule ssubst)
  qed
qed

theorem complement_of_product_is_sum_of_complements:
  "O x y \<Longrightarrow> x \<oplus> y \<noteq> u \<Longrightarrow> \<midarrow>(x \<otimes> y) = (\<midarrow>x) \<oplus> (\<midarrow>y)"
proof -
  assume "O x y"
  assume "x \<oplus> y \<noteq> u"
  show "\<midarrow>(x \<otimes> y) = (\<midarrow>x) \<oplus> (\<midarrow>y)"
  proof (rule part_antisymmetry)
    have "x \<noteq> u" using \<open>x \<oplus> y \<noteq> u\<close>
      by (rule first_summand_not_universe)
    have "y \<noteq> u" using \<open>x \<oplus> y \<noteq> u\<close>
      by (rule second_summand_not_universe)
    show "P (\<midarrow> (x \<otimes> y)) (\<midarrow> x \<oplus> \<midarrow> y)"
      using \<open>x \<noteq> u\<close> \<open>y \<noteq> u\<close> by (rule product_complement_in_complements_sum)
    show " P (\<midarrow> x \<oplus> \<midarrow> y) (\<midarrow> (x \<otimes> y))"
      using \<open>O x y\<close> \<open>x \<noteq> u\<close> \<open>y \<noteq> u\<close> by (rule complement_sum_in_product_complement)
  qed
qed

end

(*<*) end (*>*)


theory Transfer_ODE
  imports Transfer_Analysis
    Ordinary_Differential_Equations.ODE_Analysis
    "List-Index.List_Index"
begin

context includes lifting_syntax begin

lemma index_transfer[transfer_rule]:
  "(list_all2 A ===> A ===> (=)) index index"
  if [transfer_rule]: "bi_unique A"
  unfolding index_def find_index_def
  by transfer_prover

lemma interval_transfer[transfer_rule]: "(rel_set A ===> (=)) interval interval"
  if [transfer_rule]: "bi_unique A" "bi_total A" "(A ===> A ===> (=)) inner inner" "(rel_set A) Basis Basis"
  unfolding interval_def
  by transfer_prover

lemma ll_on_open_transfer[transfer_rule]:
  "(rel_set A ===> (A ===> B ===> C) ===> (rel_set B) ===> (=)) ll_on_open ll_on_open"
  if [transfer_rule]:
    "bi_unique A" "bi_total A" "(A ===> A ===> (=)) dist dist" "(A ===> A ===> (=)) inner inner" "(rel_set A) Basis Basis"
    "bi_unique B" "bi_total B" "(B ===> B ===> (=)) dist dist"
    "bi_unique C" "bi_total C" "(C ===> C ===> (=)) dist dist"
  unfolding ll_on_open_def ll_on_open_axioms_def
  by transfer_prover

lemma auto_ll_on_open_transfer[transfer_rule]:
  "((A ===> A) ===> (rel_set A) ===> (=)) auto_ll_on_open auto_ll_on_open"
  if [transfer_rule]: "bi_unique A" "bi_total A" "(A ===> A ===> (=)) dist dist"
  unfolding auto_ll_on_open_def ll_on_open_axioms_def
  by transfer_prover

lemma has_vderiv_on_transfer[transfer_rule]:
  "(((=) ===> A) ===> ((=) ===> A) ===> rel_set (=) ===> (=)) (has_vderiv_on) (has_vderiv_on)"
  if [transfer_rule]:
    "A 0 0" "bi_unique A" "bi_total A" "(rel_set A ===> (=)) open open"
    "((=) ===> A ===> A) (*\<^sub>R) (*\<^sub>R)"
    "(A ===> A ===> A) (+) (+)"
    "(A ===> A ===> A) (-) (-)"
    "(A ===> (=)) norm norm"
  unfolding has_vderiv_on_def has_vector_derivative_def has_derivative_within
  by transfer_prover

lemma solves_ode_transfer[transfer_rule]:
  "(((=) ===> A) ===> ((=) ===> A ===> A)  ===> rel_set (=) ===> rel_set A ===> (=)) (solves_ode) (solves_ode)"
  if [transfer_rule]:
    "A 0 0" "bi_unique A" "bi_total A" "(rel_set A ===> (=)) open open"
    "((=) ===> A ===> A) (*\<^sub>R) (*\<^sub>R)"
    "(A ===> A ===> A) (+) (+)"
    "(A ===> A ===> A) (-) (-)"
    "(A ===> (=)) norm norm"
  unfolding solves_ode_def
  by transfer_prover

lemma c1_on_open_transfer[transfer_rule]:
  "((A ===> A) ===> (A ===> rel_blinfun A A) ===> rel_set A ===> (=)) c1_on_open c1_on_open"
  if [transfer_rule]:
    "bi_unique A" "bi_total A"
    "(A ===> A ===> A) (+) (+)"
    "(A ===> A ===> A) (-) (-)"
    "((=) ===> A ===> A) (*\<^sub>R) (*\<^sub>R)"
    "(A ===> (=)) norm norm"
    "A 0 0"
  unfolding c1_on_open_def has_derivative_at
  by transfer_prover

end

end


(*  Title:      HOL/Nitpick_Examples/Manual_Nits.thy
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2009-2014

Examples from the Nitpick manual.
*)

section \<open>Examples from the Nitpick Manual\<close>

(* The "expect" arguments to Nitpick in this theory and the other example
   theories are there so that the example can also serve as a regression test
   suite. *)

theory Manual_Nits
imports HOL.Real "HOL-Library.Quotient_Product"
begin

section \<open>2. First Steps\<close>

nitpick_params [sat_solver = MiniSat, max_threads = 1, timeout = 240]

subsection \<open>2.1. Propositional Logic\<close>

lemma "P \<longleftrightarrow> Q"
nitpick [expect = genuine]
apply auto
nitpick [expect = genuine] 1
nitpick [expect = genuine] 2
oops

subsection \<open>2.2. Type Variables\<close>

lemma "x \<in> A \<Longrightarrow> (THE y. y \<in> A) \<in> A"
nitpick [verbose, expect = genuine]
oops

subsection \<open>2.3. Constants\<close>

lemma "x \<in> A \<Longrightarrow> (THE y. y \<in> A) \<in> A"
nitpick [show_consts, expect = genuine]
nitpick [dont_specialize, show_consts, expect = genuine]
oops

lemma "\<exists>!x. x \<in> A \<Longrightarrow> (THE y. y \<in> A) \<in> A"
nitpick [expect = none]
nitpick [card 'a = 1-50, expect = none]
(* sledgehammer *)
by (metis the_equality)

subsection \<open>2.4. Skolemization\<close>

lemma "\<exists>g. \<forall>x. g (f x) = x \<Longrightarrow> \<forall>y. \<exists>x. y = f x"
nitpick [expect = genuine]
oops

lemma "\<exists>x. \<forall>f. f x = x"
nitpick [expect = genuine]
oops

lemma "refl r \<Longrightarrow> sym r"
nitpick [expect = genuine]
oops

subsection \<open>2.5. Natural Numbers and Integers\<close>

lemma "\<lbrakk>i \<le> j; n \<le> (m::int)\<rbrakk> \<Longrightarrow> i * n + j * m \<le> i * m + j * n"
nitpick [expect = genuine]
nitpick [binary_ints, bits = 16, expect = genuine]
oops

lemma "\<forall>n. Suc n \<noteq> n \<Longrightarrow> P"
nitpick [card nat = 100, expect = potential]
oops

lemma "P Suc"
nitpick [expect = none]
oops

lemma "P ((+)::nat\<Rightarrow>nat\<Rightarrow>nat)"
nitpick [card nat = 1, expect = genuine]
nitpick [card nat = 2, expect = none]
oops

subsection \<open>2.6. Inductive Datatypes\<close>

lemma "hd (xs @ [y, y]) = hd xs"
nitpick [expect = genuine]
nitpick [show_consts, show_types, expect = genuine]
oops

lemma "\<lbrakk>length xs = 1; length ys = 1\<rbrakk> \<Longrightarrow> xs = ys"
nitpick [show_types, expect = genuine]
oops

subsection \<open>2.7. Typedefs, Records, Rationals, and Reals\<close>

definition "three = {0::nat, 1, 2}"
typedef three = three
  unfolding three_def by blast

definition A :: three where "A \<equiv> Abs_three 0"
definition B :: three where "B \<equiv> Abs_three 1"
definition C :: three where "C \<equiv> Abs_three 2"

lemma "\<lbrakk>A \<in> X; B \<in> X\<rbrakk> \<Longrightarrow> c \<in> X"
nitpick [show_types, expect = genuine]
oops

fun my_int_rel where
"my_int_rel (x, y) (u, v) = (x + v = u + y)"

quotient_type my_int = "nat \<times> nat" / my_int_rel
by (auto simp add: equivp_def fun_eq_iff)

definition add_raw where
"add_raw \<equiv> \<lambda>(x, y) (u, v). (x + (u::nat), y + (v::nat))"

quotient_definition "add::my_int \<Rightarrow> my_int \<Rightarrow> my_int" is add_raw
unfolding add_raw_def by auto

lemma "add x y = add x x"
nitpick [show_types, expect = genuine]
oops

ML \<open>
fun my_int_postproc _ _ _ T (Const _ $ (Const _ $ t1 $ t2)) =
    HOLogic.mk_number T (snd (HOLogic.dest_number t1)
                         - snd (HOLogic.dest_number t2))
  | my_int_postproc _ _ _ _ t = t
\<close>

declaration \<open>
Nitpick_Model.register_term_postprocessor \<^Type>\<open>my_int\<close> my_int_postproc
\<close>

lemma "add x y = add x x"
nitpick [show_types]
oops

record point =
  Xcoord :: int
  Ycoord :: int

lemma "Xcoord (p::point) = Xcoord (q::point)"
nitpick [show_types, expect = genuine]
oops

lemma "4 * x + 3 * (y::real) \<noteq> 1 / 2"
nitpick [show_types, expect = genuine]
oops

subsection \<open>2.8. Inductive and Coinductive Predicates\<close>

inductive even where
"even 0" |
"even n \<Longrightarrow> even (Suc (Suc n))"

lemma "\<exists>n. even n \<and> even (Suc n)"
nitpick [card nat = 50, unary_ints, verbose, expect = potential]
oops

lemma "\<exists>n \<le> 49. even n \<and> even (Suc n)"
nitpick [card nat = 50, unary_ints, expect = genuine]
oops

inductive even' where
"even' (0::nat)" |
"even' 2" |
"\<lbrakk>even' m; even' n\<rbrakk> \<Longrightarrow> even' (m + n)"

lemma "\<exists>n \<in> {0, 2, 4, 6, 8}. \<not> even' n"
nitpick [card nat = 10, unary_ints, verbose, show_consts, expect = genuine]
oops

lemma "even' (n - 2) \<Longrightarrow> even' n"
nitpick [card nat = 10, show_consts, expect = genuine]
oops

coinductive nats where
"nats (x::nat) \<Longrightarrow> nats x"

lemma "nats = (\<lambda>n. n \<in> {0, 1, 2, 3, 4})"
nitpick [card nat = 10, show_consts, expect = genuine]
oops

inductive odd where
"odd 1" |
"\<lbrakk>odd m; even n\<rbrakk> \<Longrightarrow> odd (m + n)"

lemma "odd n \<Longrightarrow> odd (n - 2)"
nitpick [card nat = 4, show_consts, expect = genuine]
oops

subsection \<open>2.9. Coinductive Datatypes\<close>

codatatype 'a llist = LNil | LCons 'a "'a llist"

primcorec iterates where
"iterates f a = LCons a (iterates f (f a))"

lemma "xs \<noteq> LCons a xs"
nitpick [expect = genuine]
oops

lemma "\<lbrakk>xs = LCons a xs; ys = iterates (\<lambda>b. a) b\<rbrakk> \<Longrightarrow> xs = ys"
nitpick [verbose, expect = genuine]
oops

lemma "\<lbrakk>xs = LCons a xs; ys = LCons a ys\<rbrakk> \<Longrightarrow> xs = ys"
nitpick [bisim_depth = -1, show_types, expect = quasi_genuine]
nitpick [card = 1-5, expect = none]
sorry

subsection \<open>2.10. Boxing\<close>

datatype tm = Var nat | Lam tm | App tm tm

primrec lift where
"lift (Var j) k = Var (if j < k then j else j + 1)" |
"lift (Lam t) k = Lam (lift t (k + 1))" |
"lift (App t u) k = App (lift t k) (lift u k)"

primrec loose where
"loose (Var j) k = (j \<ge> k)" |
"loose (Lam t) k = loose t (Suc k)" |
"loose (App t u) k = (loose t k \<or> loose u k)"

primrec subst\<^sub>1 where
"subst\<^sub>1 \<sigma> (Var j) = \<sigma> j" |
"subst\<^sub>1 \<sigma> (Lam t) =
 Lam (subst\<^sub>1 (\<lambda>n. case n of 0 \<Rightarrow> Var 0 | Suc m \<Rightarrow> lift (\<sigma> m) 1) t)" |
"subst\<^sub>1 \<sigma> (App t u) = App (subst\<^sub>1 \<sigma> t) (subst\<^sub>1 \<sigma> u)"

lemma "\<not> loose t 0 \<Longrightarrow> subst\<^sub>1 \<sigma> t = t"
nitpick [verbose, expect = genuine]
nitpick [eval = "subst\<^sub>1 \<sigma> t", expect = genuine]
(* nitpick [dont_box, expect = unknown] *)
oops

primrec subst\<^sub>2 where
"subst\<^sub>2 \<sigma> (Var j) = \<sigma> j" |
"subst\<^sub>2 \<sigma> (Lam t) =
 Lam (subst\<^sub>2 (\<lambda>n. case n of 0 \<Rightarrow> Var 0 | Suc m \<Rightarrow> lift (\<sigma> m) 0) t)" |
"subst\<^sub>2 \<sigma> (App t u) = App (subst\<^sub>2 \<sigma> t) (subst\<^sub>2 \<sigma> u)"

lemma "\<not> loose t 0 \<Longrightarrow> subst\<^sub>2 \<sigma> t = t"
nitpick [card = 1-5, expect = none]
sorry

subsection \<open>2.11. Scope Monotonicity\<close>

lemma "length xs = length ys \<Longrightarrow> rev (zip xs ys) = zip xs (rev ys)"
nitpick [verbose, expect = genuine]
oops

lemma "\<exists>g. \<forall>x::'b. g (f x) = x \<Longrightarrow> \<forall>y::'a. \<exists>x. y = f x"
nitpick [mono, expect = none]
nitpick [expect = genuine]
oops

subsection \<open>2.12. Inductive Properties\<close>

inductive_set reach where
"(4::nat) \<in> reach" |
"n \<in> reach \<Longrightarrow> n < 4 \<Longrightarrow> 3 * n + 1 \<in> reach" |
"n \<in> reach \<Longrightarrow> n + 2 \<in> reach"

lemma "n \<in> reach \<Longrightarrow> 2 dvd n"
(* nitpick *)
apply (induct set: reach)
  apply auto
 nitpick [card = 1-4, bits = 1-4, expect = none]
 apply (thin_tac "n \<in> reach")
 nitpick [expect = genuine]
oops

lemma "n \<in> reach \<Longrightarrow> 2 dvd n \<and> n \<noteq> 0"
(* nitpick *)
apply (induct set: reach)
  apply auto
 nitpick [card = 1-4, bits = 1-4, expect = none]
 apply (thin_tac "n \<in> reach")
 nitpick [expect = genuine]
oops

lemma "n \<in> reach \<Longrightarrow> 2 dvd n \<and> n \<ge> 4"
by (induct set: reach) arith+

section \<open>3. Case Studies\<close>

nitpick_params [max_potential = 0]

subsection \<open>3.1. A Context-Free Grammar\<close>

datatype alphabet = a | b

inductive_set S\<^sub>1 and A\<^sub>1 and B\<^sub>1 where
  "[] \<in> S\<^sub>1"
| "w \<in> A\<^sub>1 \<Longrightarrow> b # w \<in> S\<^sub>1"
| "w \<in> B\<^sub>1 \<Longrightarrow> a # w \<in> S\<^sub>1"
| "w \<in> S\<^sub>1 \<Longrightarrow> a # w \<in> A\<^sub>1"
| "w \<in> S\<^sub>1 \<Longrightarrow> b # w \<in> S\<^sub>1"
| "\<lbrakk>v \<in> B\<^sub>1; v \<in> B\<^sub>1\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>1"

theorem S\<^sub>1_sound:
"w \<in> S\<^sub>1 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
nitpick [expect = genuine]
oops

inductive_set S\<^sub>2 and A\<^sub>2 and B\<^sub>2 where
  "[] \<in> S\<^sub>2"
| "w \<in> A\<^sub>2 \<Longrightarrow> b # w \<in> S\<^sub>2"
| "w \<in> B\<^sub>2 \<Longrightarrow> a # w \<in> S\<^sub>2"
| "w \<in> S\<^sub>2 \<Longrightarrow> a # w \<in> A\<^sub>2"
| "w \<in> S\<^sub>2 \<Longrightarrow> b # w \<in> B\<^sub>2"
| "\<lbrakk>v \<in> B\<^sub>2; v \<in> B\<^sub>2\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>2"

theorem S\<^sub>2_sound:
"w \<in> S\<^sub>2 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
nitpick [expect = genuine]
oops

inductive_set S\<^sub>3 and A\<^sub>3 and B\<^sub>3 where
  "[] \<in> S\<^sub>3"
| "w \<in> A\<^sub>3 \<Longrightarrow> b # w \<in> S\<^sub>3"
| "w \<in> B\<^sub>3 \<Longrightarrow> a # w \<in> S\<^sub>3"
| "w \<in> S\<^sub>3 \<Longrightarrow> a # w \<in> A\<^sub>3"
| "w \<in> S\<^sub>3 \<Longrightarrow> b # w \<in> B\<^sub>3"
| "\<lbrakk>v \<in> B\<^sub>3; w \<in> B\<^sub>3\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>3"

theorem S\<^sub>3_sound:
"w \<in> S\<^sub>3 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
nitpick [card = 1-5, expect = none]
sorry

theorem S\<^sub>3_complete:
"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> w \<in> S\<^sub>3"
nitpick [expect = genuine]
oops

inductive_set S\<^sub>4 and A\<^sub>4 and B\<^sub>4 where
  "[] \<in> S\<^sub>4"
| "w \<in> A\<^sub>4 \<Longrightarrow> b # w \<in> S\<^sub>4"
| "w \<in> B\<^sub>4 \<Longrightarrow> a # w \<in> S\<^sub>4"
| "w \<in> S\<^sub>4 \<Longrightarrow> a # w \<in> A\<^sub>4"
| "\<lbrakk>v \<in> A\<^sub>4; w \<in> A\<^sub>4\<rbrakk> \<Longrightarrow> b # v @ w \<in> A\<^sub>4"
| "w \<in> S\<^sub>4 \<Longrightarrow> b # w \<in> B\<^sub>4"
| "\<lbrakk>v \<in> B\<^sub>4; w \<in> B\<^sub>4\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>4"

theorem S\<^sub>4_sound:
"w \<in> S\<^sub>4 \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
nitpick [card = 1-5, expect = none]
sorry

theorem S\<^sub>4_complete:
"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> w \<in> S\<^sub>4"
nitpick [card = 1-5, expect = none]
sorry

theorem S\<^sub>4_A\<^sub>4_B\<^sub>4_sound_and_complete:
"w \<in> S\<^sub>4 \<longleftrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
"w \<in> A\<^sub>4 \<longleftrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] + 1"
"w \<in> B\<^sub>4 \<longleftrightarrow> length [x \<leftarrow> w. x = b] = length [x \<leftarrow> w. x = a] + 1"
nitpick [card = 1-5, expect = none]
sorry

subsection \<open>3.2. AA Trees\<close>

datatype 'a aa_tree = \<Lambda> | N "'a::linorder" nat "'a aa_tree" "'a aa_tree"

primrec data where
"data \<Lambda> = undefined" |
"data (N x _ _ _) = x"

primrec dataset where
"dataset \<Lambda> = {}" |
"dataset (N x _ t u) = {x} \<union> dataset t \<union> dataset u"

primrec level where
"level \<Lambda> = 0" |
"level (N _ k _ _) = k"

primrec left where
"left \<Lambda> = \<Lambda>" |
"left (N _ _ t\<^sub>1 _) = t\<^sub>1"

primrec right where
"right \<Lambda> = \<Lambda>" |
"right (N _ _ _ t\<^sub>2) = t\<^sub>2"

fun wf where
"wf \<Lambda> = True" |
"wf (N _ k t u) =
 (if t = \<Lambda> then
    k = 1 \<and> (u = \<Lambda> \<or> (level u = 1 \<and> left u = \<Lambda> \<and> right u = \<Lambda>))
  else
    wf t \<and> wf u \<and> u \<noteq> \<Lambda> \<and> level t < k \<and> level u \<le> k \<and> level (right u) < k)"

fun skew where
"skew \<Lambda> = \<Lambda>" |
"skew (N x k t u) =
 (if t \<noteq> \<Lambda> \<and> k = level t then
    N (data t) k (left t) (N x k (right t) u)
  else
    N x k t u)"

fun split where
"split \<Lambda> = \<Lambda>" |
"split (N x k t u) =
 (if u \<noteq> \<Lambda> \<and> k = level (right u) then
    N (data u) (Suc k) (N x k t (left u)) (right u)
  else
    N x k t u)"

theorem dataset_skew_split:
"dataset (skew t) = dataset t"
"dataset (split t) = dataset t"
nitpick [card = 1-5, expect = none]
sorry

theorem wf_skew_split:
"wf t \<Longrightarrow> skew t = t"
"wf t \<Longrightarrow> split t = t"
nitpick [card = 1-5, expect = none]
sorry

primrec insort\<^sub>1 where
"insort\<^sub>1 \<Lambda> x = N x 1 \<Lambda> \<Lambda>" |
"insort\<^sub>1 (N y k t u) x =
 \<^cancel>\<open>(split \<circ> skew)\<close> (N y k (if x < y then insort\<^sub>1 t x else t)
                             (if x > y then insort\<^sub>1 u x else u))"

theorem wf_insort\<^sub>1: "wf t \<Longrightarrow> wf (insort\<^sub>1 t x)"
nitpick [expect = genuine]
oops

theorem wf_insort\<^sub>1_nat: "wf t \<Longrightarrow> wf (insort\<^sub>1 t (x::nat))"
nitpick [eval = "insort\<^sub>1 t x", expect = genuine]
oops

primrec insort\<^sub>2 where
"insort\<^sub>2 \<Lambda> x = N x 1 \<Lambda> \<Lambda>" |
"insort\<^sub>2 (N y k t u) x =
 (split \<circ> skew) (N y k (if x < y then insort\<^sub>2 t x else t)
                       (if x > y then insort\<^sub>2 u x else u))"

theorem wf_insort\<^sub>2: "wf t \<Longrightarrow> wf (insort\<^sub>2 t x)"
nitpick [card = 1-5, expect = none]
sorry

theorem dataset_insort\<^sub>2: "dataset (insort\<^sub>2 t x) = {x} \<union> dataset t"
nitpick [card = 1-5, expect = none]
sorry

end