(*
  File:     Furstenberg_Topology.thy
  Author:   Manuel Eberl, TU München
*)
section \<open>Furstenberg's topology and his proof of the infinitude of primes\<close>
theory Furstenberg_Topology
  imports
    "HOL-Real_Asymp.Real_Asymp"
    "HOL-Analysis.Analysis"
    "HOL-Number_Theory.Number_Theory"
begin

text \<open>
  This article gives a formal version of Furstenberg's topological proof of the infinitude of
  primes~\<^cite>\<open>"furstenberg"\<close>. He defines a topology on the integers based on arithmetic progressions
  (or, equivalently, residue classes).

  Apart from yielding a short proof of the infinitude of primes, this topology is also fairly
  `nice' in general: it is second countable, metrizable, and perfect. All of these (well-known)
  facts will be formally proven below.
\<close>

subsection \<open>Arithmetic progressions of integers\<close>

text \<open>
  We first define `bidirectional infinite arithmetic progressions' on \<open>\<int>\<close> in the sense that
  to an integer \<open>a\<close> and a positive integer \<open>b\<close>, we associate all the integers \<open>x\<close> such that
  $x \equiv a\ (\text{mod}\ b)$, or, equivalently, $\{a + nb\mid n\in\mathbb{Z}\}$.
\<close>

definition arith_prog :: "int \<Rightarrow> nat \<Rightarrow> int set" where
  "arith_prog a b = {x. [x = a] (mod int b)}"

lemma arith_prog_0_right [simp]: "arith_prog a 0 = {a}"
  by (simp add: arith_prog_def)

lemma arith_prog_Suc_0_right [simp]: "arith_prog a (Suc 0) = UNIV"
  by (auto simp: arith_prog_def)

lemma in_arith_progI [intro]: "[x = a] (mod b) \<Longrightarrow> x \<in> arith_prog a b"
  by (auto simp: arith_prog_def)

text \<open>
  Two arithmetic progressions with the same period and noncongruent starting points are
  disjoint.
\<close>
lemma arith_prog_disjoint:
  assumes "[a \<noteq> a'] (mod int b)" and "b > 0"
  shows   "arith_prog a b \<inter> arith_prog a' b = {}"
  using assms by (auto simp: arith_prog_def cong_def)

text \<open>
  Multiplying the period gives us a subset of the original progression.
\<close>
lemma arith_prog_dvd_mono: "b dvd b' \<Longrightarrow> arith_prog a b' \<subseteq> arith_prog a b"
  by (auto simp: arith_prog_def cong_dvd_modulus)

text \<open>
  The following proves the alternative definition mentioned above.
\<close>
lemma bij_betw_arith_prog:
  assumes "b > 0"
  shows   "bij_betw (\<lambda>n. a + int b * n) UNIV (arith_prog a b)"
proof (rule bij_betwI[of _ _ _ "\<lambda>x. (x - a) div int b"], goal_cases)
  case 1
  thus ?case
    by (auto simp: arith_prog_def cong_add_lcancel_0 cong_mult_self_right mult_of_nat_commute)
next
  case 4
  thus ?case
    by (auto simp: arith_prog_def cong_iff_lin)
qed (use \<open>b > 0\<close> in \<open>auto simp: arith_prog_def\<close>)

lemma arith_prog_altdef: "arith_prog a b = range (\<lambda>n. a + int b * n)"
proof (cases "b = 0")
  case False
  thus ?thesis
    using bij_betw_arith_prog[of b] by (auto simp: bij_betw_def)
qed auto

text \<open>
  A simple corollary from this is also that any such arithmetic progression is infinite.
\<close>
lemma infinite_arith_prog: "b > 0 \<Longrightarrow> infinite (arith_prog a b)"
  using bij_betw_finite[OF bij_betw_arith_prog[of b]] by simp

subsection \<open>The Furstenberg topology on \<open>\<int>\<close>\<close>

text \<open>
  The typeclass-based topology is somewhat nicer to use in Isabelle/HOL, but the integers,
  of course, already have a topology associated to them. We therefore need to introduce a type
  copy of the integers and furnish them with the new topology. We can easily convert between
  them and the `proper' integers using Lifting and Transfer.
\<close>
typedef fbint = "UNIV :: int set"
  morphisms int_of_fbint fbint ..

setup_lifting type_definition_fbint

lift_definition arith_prog_fb :: "int \<Rightarrow> nat \<Rightarrow> fbint set" is "arith_prog" .

instantiation fbint :: topological_space
begin

text \<open>
  Furstenberg defined the topology as the one generated by all arithmetic progressions.
  We use a slightly more explicit equivalent formulation that exploits the fact that
  the intersection of two arithmetic progressions is again an arithmetic progression (or empty).
\<close>
lift_definition open_fbint :: "fbint set \<Rightarrow> bool" is
  "\<lambda>U. (\<forall>x\<in>U. \<exists>b>0. arith_prog x b \<subseteq> U)" .

text \<open>
  We now prove that this indeed forms a topology.
\<close>
instance proof
  show "open (UNIV :: fbint set)"
    by transfer auto
next
  fix U V :: "fbint set"
  assume "open U" and "open V"
  show "open (U \<inter> V)"
  proof (use \<open>open U\<close> \<open>open V\<close> in transfer, safe)
    fix U V :: "int set" and x :: int
    assume U: "\<forall>x\<in>U. \<exists>b>0. arith_prog x b \<subseteq> U" and V: "\<forall>x\<in>V. \<exists>b>0. arith_prog x b \<subseteq> V"
    assume x: "x \<in> U" "x \<in> V"
    from U x obtain b1 where b1: "b1 > 0" "arith_prog x b1 \<subseteq> U" by auto
    from V x obtain b2 where b2: "b2 > 0" "arith_prog x b2 \<subseteq> V" by auto
    from b1 b2 have "lcm b1 b2 > 0" "arith_prog x (lcm b1 b2) \<subseteq> U \<inter> V"
      using arith_prog_dvd_mono[of b1 "lcm b1 b2" x] arith_prog_dvd_mono[of b2 "lcm b1 b2" x]
      by (auto simp: lcm_pos_nat)
    thus "\<exists>b>0. arith_prog x b \<subseteq> U \<inter> V" by blast
  qed
next
  fix F :: "fbint set set"
  assume *: "\<forall>U\<in>F. open U"
  show "open (\<Union>F)"
  proof (use * in transfer, safe)
    fix F :: "int set set" and U :: "int set" and x :: int
    assume F: "\<forall>U\<in>F. \<forall>x\<in>U. \<exists>b>0. arith_prog x b \<subseteq> U"
    assume "x \<in> U" "U \<in> F"
    with F obtain b where b: "b > 0" "arith_prog x b \<subseteq> U" by blast
    with \<open>U \<in> F\<close> show "\<exists>b>0. arith_prog x b \<subseteq> \<Union>F"
      by blast
  qed
qed

end

text \<open>
  Since any non-empty open set contains an arithmetic progression and arithmetic progressions
  are infinite, we obtain that all nonempty open sets are infinite.
\<close>
lemma open_fbint_imp_infinite:
  fixes U :: "fbint set"
  assumes "open U" and "U \<noteq> {}"
  shows   "infinite U"
  using assms
proof transfer
  fix U :: "int set"
  assume *: "\<forall>x\<in>U. \<exists>b>0. arith_prog x b \<subseteq> U" and "U \<noteq> {}"
  from \<open>U \<noteq> {}\<close> obtain x where "x \<in> U" by auto
  with * obtain b where b: "b > 0" "arith_prog x b \<subseteq> U" by auto
  from b have "infinite (arith_prog x b)"
    using infinite_arith_prog by blast
  with b show "infinite U"
    using finite_subset by blast
qed

lemma not_open_finite_fbint [simp]:
  assumes "finite (U :: fbint set)" "U \<noteq> {}"
  shows   "\<not>open U"
  using open_fbint_imp_infinite assms by blast

text \<open>
  More or less by definition, any arithmetic progression is open.
\<close>
lemma open_arith_prog_fb [intro]:
  assumes "b > 0"
  shows   "open (arith_prog_fb a b)"
  using assms
proof transfer
  fix a :: int and b :: nat
  assume "b > 0"
  show "\<forall>x\<in>arith_prog a b. \<exists>b'>0. arith_prog x b' \<subseteq> arith_prog a b"
  proof (intro ballI exI[of _ b] conjI)
    fix x assume "x \<in> arith_prog a b"
    thus "arith_prog x b \<subseteq> arith_prog a b"
      using cong_trans by (auto simp: arith_prog_def )
  qed (use \<open>b > 0\<close> in auto)
qed

text \<open>
  Slightly less obviously, any arithmetic progression is also closed.
  This can be seen by realising that for a period \<open>b\<close>, we can partition the integers
  into \<open>b\<close> congruence classes and then the complement of each congruence class is the
  union of the other \<open>b - 1\<close> classes, and unions of open sets are open.
\<close>
lemma closed_arith_prog_fb [intro]:
  assumes "b > 0"
  shows   "closed (arith_prog_fb a b)"
proof -
  have "open (-arith_prog_fb a b)"
  proof -
    have "-arith_prog_fb a b = (\<Union>i\<in>{1..<b}. arith_prog_fb (a+i) b)"
    proof (transfer fixing: b)
      fix a :: int
      have disjoint: "x \<notin> arith_prog a b" if "x \<in> arith_prog (a + int i) b" "i \<in> {1..<b}" for x i
      proof -
        have "[a \<noteq> a + int i] (mod int b)"
        proof
          assume "[a = a + int i] (mod int b)"
          hence "[a + 0 = a + int i] (mod int b)" by simp
          hence "[0 = int i] (mod int b)" by (subst (asm) cong_add_lcancel) auto
          with that show False by (auto simp: cong_def)
        qed
        thus ?thesis using arith_prog_disjoint[of a "a + int i" b] \<open>b > 0\<close> that by auto
      qed

      have covering: "x \<in> arith_prog a b \<or> x \<in> (\<Union>i\<in>{1..<b}. arith_prog (a + int i) b)" for x
      proof -
        define i where "i = nat ((x - a) mod (int b))"
        have "[a + int i = a + (x - a) mod int b] (mod int b)"
          unfolding i_def using \<open>b > 0\<close> by simp
        also have "[a + (x - a) mod int b = a + (x - a)] (mod int b)"
          by (intro cong_add) auto
        finally have "[x = a + int i] (mod int b)"
          by (simp add: cong_sym_eq)
        hence "x \<in> arith_prog (a + int i) b"
          using \<open>b > 0\<close> by (auto simp: arith_prog_def)
        moreover have "i < b" using \<open>b > 0\<close>
          by (auto simp: i_def nat_less_iff)
        ultimately show ?thesis using \<open>b > 0\<close>
          by (cases "i = 0") auto
      qed

      from disjoint and covering show "- arith_prog a b = (\<Union>i\<in>{1..<b}. arith_prog (a + int i) b)"
        by blast
    qed
    also from \<open>b > 0\<close> have "open \<dots>"
      by auto
    finally show ?thesis .
  qed
  thus ?thesis by (simp add: closed_def)
qed

subsection \<open>The infinitude of primes\<close>

text \<open>
  The infinite of the primes now follows quite obviously: The multiples of any prime form a
  closed set, so if there were only finitely many primes, the union of all of these would also
  be open. However, since any number other than \<open>\<plusminus>1\<close> has a prime divisor, the union of all these
  sets is simply \<open>\<int>\<setminus>{\<plusminus>1}\<close>, which is obviously \<^emph>\<open>not\<close> closed since the finite set \<open>{\<plusminus>1}\<close> is not
  open.
\<close>
theorem "infinite {p::nat. prime p}"
proof
  assume fin: "finite {p::nat. prime p}"
  define A where "A = (\<Union>p\<in>{p::nat. prime p}. arith_prog_fb 0 p)"
  have "closed A"
    unfolding A_def using fin by (intro closed_Union) (auto simp: prime_gt_0_nat)
  hence "open (-A)"
    by (simp add: closed_def)
  also have "A = -{fbint 1, fbint (-1)}"
    unfolding A_def
  proof transfer
    show "(\<Union>p\<in>{p::nat. prime p}. arith_prog 0 p) = - {1, - 1}"
    proof (intro equalityI subsetI)
      fix x :: int assume x: "x \<in> -{1, -1}"
      hence "\<bar>x\<bar> \<noteq> 1" by auto
      show "x \<in> (\<Union>p\<in>{p::nat. prime p}. arith_prog 0 p)"
      proof (cases "x = 0")
        case True
        thus ?thesis
          by (auto simp: A_def intro!: exI[of _ 2])
      next
        case [simp]: False
        obtain p where p: "prime p" "p dvd x"
          using prime_divisor_exists[of x] and \<open>\<bar>x\<bar> \<noteq> 1\<close> by auto
        hence "x \<in> arith_prog 0 (nat p)" using prime_gt_0_int[of p]
          by (auto simp: arith_prog_def cong_0_iff)
        thus ?thesis using p
          by (auto simp: A_def intro!: exI[of _ "nat p"])
      qed
    qed (auto simp: A_def arith_prog_def cong_0_iff)
  qed
  also have "-(-{fbint 1, fbint (-1)}) = {fbint 1, fbint (-1)}"
    by simp
  finally have "open {fbint 1, fbint (-1)}" .
  thus False by simp
qed

subsection \<open>Additional topological properties\<close>

text \<open>
  Just for fun, let us also show a few more properties of Furstenberg's topology.
  First, we show the equivalence to the above to Furstenberg's original definition
  (the topology generated by all arithmetic progressions).
\<close>

text \<open>
  From this, we can immediately see that it is second countable:
\<close>
instance fbint :: second_countable_topology
proof
  have "countable ((\<lambda>(a,b). arith_prog_fb a b) ` (UNIV \<times> {b. b > 0}))"
    by (intro countable_image) auto
  also have "\<dots> = {arith_prog_fb a b |a b. b > 0}"
    by auto
  ultimately show "\<exists>B::fbint set set. countable B \<and> open = generate_topology B"
    unfolding open_fbint_altdef by auto
qed

text \<open>
  A trivial consequence of the fact that nonempty open sets in this topology are infinite
  is that it is a perfect space:
\<close>
instance fbint :: perfect_space
  by standard auto

text \<open>
  It is also Hausdorff, since given any two distinct integers, we can easily
  construct two non-overlapping arithmetic progressions that each contain one of them.
  We do not \<^emph>\<open>really\<close> have to prove this since we will get it for free later on when we
  show that it is a metric space, but here is the proof anyway:
\<close>
instance fbint :: t2_space
proof
  fix x y :: fbint
  assume "x \<noteq> y"
  define d where "d = nat \<bar>int_of_fbint x - int_of_fbint y\<bar> + 1"
  from \<open>x \<noteq> y\<close> have "d > 0"
    unfolding d_def by transfer auto
  define U where "U = arith_prog_fb (int_of_fbint x) d"
  define V where "V = arith_prog_fb (int_of_fbint y) d"

  have "U \<inter> V = {}" unfolding U_def V_def d_def
  proof (use \<open>x \<noteq> y\<close> in transfer, rule arith_prog_disjoint)
    fix x y :: int
    assume "x \<noteq> y"
    show "[x \<noteq> y] (mod int (nat \<bar>x - y\<bar> + 1))"
    proof
      assume "[x = y] (mod int (nat \<bar>x - y\<bar> + 1))"
      hence "\<bar>x - y\<bar> + 1 dvd \<bar>x - y\<bar>"
        by (auto simp: cong_iff_dvd_diff algebra_simps)
      hence "\<bar>x - y\<bar> + 1 \<le> \<bar>x - y\<bar>"
        by (rule zdvd_imp_le) (use \<open>x \<noteq> y\<close> in auto)
      thus False by simp
    qed
  qed auto
  moreover have "x \<in> U" "y \<in> V"
    unfolding U_def V_def by (use \<open>d > 0\<close> in transfer, fastforce)+
  moreover have "open U" "open V"
    using \<open>d > 0\<close> by (auto simp: U_def V_def)
  ultimately show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}" by blast
qed

(* TODO Move? *)
text \<open>
  Next, we need a small lemma: Given an additional assumption, a $T_2$ space is also $T_3$:
\<close>
lemma t2_space_t3_spaceI:
  assumes "\<And>(x :: 'a :: t2_space) U. x \<in> U \<Longrightarrow> open U \<Longrightarrow>
             \<exists>V. x \<in> V \<and> open V \<and> closure V \<subseteq> U"
  shows   "OFCLASS('a, t3_space_class)"
proof
  fix X :: "'a set" and z :: 'a
  assume X: "closed X" "z \<notin> X"
  with assms[of z "-X"] obtain V where V: "z \<in> V" "open V" "closure V \<subseteq> -X"
    by auto
  show "\<exists>U V. open U \<and> open V \<and> z \<in> U \<and> X \<subseteq> V \<and> U \<inter> V = {}"
    by (rule exI[of _ V], rule exI[of _ "-closure V"])
       (use X V closure_subset[of V] in auto)
qed

text \<open>
  Since the Furstenberg topology is $T_2$ and every arithmetic progression is also closed,
  we can now easily show that it is also $T_3$ (i.\,e.\ regular).
  Again, we do not really need this proof, but here it is:
\<close>
instance fbint :: t3_space
proof (rule t2_space_t3_spaceI)
  fix x :: fbint and U :: "fbint set"
  assume "x \<in> U" and "open U"
  then obtain b where b: "b > 0" "arith_prog_fb (int_of_fbint x) b \<subseteq> U"
    by transfer blast
  define V where "V = arith_prog_fb (int_of_fbint x) b"
  have "x \<in> V"
    unfolding V_def by transfer auto
  moreover have "open V" "closed V"
    using \<open>b > 0\<close> by (auto simp: V_def)
  ultimately show "\<exists>V. x \<in> V \<and> open V \<and> closure V \<subseteq> U"
    using b by (intro exI[of _ V]) (auto simp: V_def)
qed

subsection \<open>Metrizability\<close>

text \<open>
  The metrizability of Furstenberg's topology (i.\,e.\ that it is induced by some metric) can
  be shown from the fact that it is second countable and $T_3$ using Urysohn's Metrization Theorem,
  but this is not available in Isabelle yet. Let us therefore give an \<^emph>\<open>explicit\<close> metric,
  as described by Zulfeqarr~\<^cite>\<open>"zulfeqarr"\<close>. We follow the exposition by Dirmeier~\<^cite>\<open>"dirmeier"\<close>.

  First, we define a kind of norm on the integers. The norm depends on a real parameter \<open>q > 1\<close>.
  The value of \<open>q\<close> does not matter in the sense that all values induce the same topology
  (which we will show). For the final definition, we then simply pick \<open>q = 2\<close>.
\<close>

locale fbnorm =
  fixes q :: "real"
  assumes q_gt_1: "q > 1"
begin

definition N :: "int \<Rightarrow> real" where
  "N n = (\<Sum>k. if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k)"

lemma N_summable: "summable (\<lambda>k. if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k)"
  by (rule summable_comparison_test[OF _ summable_geometric[of "1/q"]])
     (use q_gt_1 in \<open>auto intro!: exI[of _ 0] simp: power_divide\<close>)

lemma N_sums: "(\<lambda>k. if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k) sums N n"
  using N_summable unfolding N_def by (rule summable_sums)

lemma N_nonneg: "N n \<ge> 0"
  by (rule sums_le[OF _ sums_zero N_sums]) (use q_gt_1 in auto)

lemma N_uminus [simp]: "N (-n) = N n"
  by (simp add: N_def)

lemma N_minus_commute: "N (x - y) = N (y - x)"
  using N_uminus[of "x - y"] by (simp del: N_uminus)

lemma N_zero [simp]: "N 0 = 0"
  by (simp add: N_def)

lemma not_dvd_imp_N_ge:
  assumes "\<not>n dvd a" "n > 0"
  shows   "N a \<ge> 1 / q ^ n"
  by (rule sums_le[OF _ sums_single[of n] N_sums]) (use q_gt_1 assms in auto)

lemma N_lt_imp_dvd:
  assumes "N a < 1 / q ^ n" and "n > 0"
  shows   "n dvd a"
  using not_dvd_imp_N_ge[of n a] assms by auto

lemma N_pos:
  assumes "n \<noteq> 0"
  shows   "N n > 0"
proof -
  have "0 < 1 / q ^ (nat \<bar>n\<bar>+1)"
    using q_gt_1 by simp
  also have "\<not>1 + \<bar>n\<bar> dvd \<bar>n\<bar>"
    using zdvd_imp_le[of "1 + \<bar>n\<bar>" "\<bar>n\<bar>"] assms by auto
  hence "1 / q ^ (nat \<bar>n\<bar>+1) \<le> N n"
    by (intro not_dvd_imp_N_ge) (use assms in auto)
  finally show ?thesis .
qed

lemma N_zero_iff [simp]: "N n = 0 \<longleftrightarrow> n = 0"
  using N_pos[of n] by (cases "n = 0") auto

lemma N_triangle_ineq: "N (n + m) \<le> N n + N m"
proof (rule sums_le)
  let ?I = "\<lambda>n k. if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k"
  show "?I (n + m) sums N (n + m)"
    by (rule N_sums)
  show "(\<lambda>k. ?I n k + ?I m k) sums (N n + N m)"
    by (intro sums_add N_sums)
qed (use q_gt_1 in auto)

lemma N_1: "N 1 = 1 / (q * (q - 1))"
proof (rule sums_unique2)
  have "(\<lambda>k. if k = 0 \<or> int k dvd 1 then 0 else 1 / q ^ k) sums N 1"
    by (rule N_sums)
  also have "(\<lambda>k. if k = 0 \<or> int k dvd 1 then 0 else 1 / q ^ k) =
               (\<lambda>k. if k \<in> {0, 1} then 0 else (1 / q) ^ k)"
    by (simp add: power_divide cong: if_cong)
  finally show "(\<lambda>k. if k \<in> {0, 1} then 0 else (1 / q) ^ k) sums N 1" .

  have "(\<lambda>k. if k \<in> {0, 1} then 0 else (1 / q) ^ k) sums
                 (1 / (1 - 1 / q) + (- (1 / q) - 1))"
    by (rule sums_If_finite_set'[OF geometric_sums]) (use q_gt_1 in auto)
  also have "\<dots> = 1 / (q * (q - 1))"
    using q_gt_1 by (simp add: field_simps)
  finally show "(\<lambda>k. if k \<in> {0, 1} then 0 else (1 / q) ^ k) sums \<dots>" .
qed

text \<open>
  It follows directly from the definition that norms fulfil a kind of monotonicity property
  with respect to divisibility: the norm of a number is at most as large as the norm of any of
  its factors:
\<close>
lemma N_dvd_mono:
  assumes "m dvd n"
  shows   "N n \<le> N m"
proof (rule sums_le[OF _ N_sums N_sums])
  fix k :: nat
  show "(if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k) \<le>
        (if k = 0 \<or> int k dvd m then 0 else 1 / q ^ k)"
    using q_gt_1 assms by auto
qed

text \<open>
  In particular, this means that 1 and -1 have the greatest norm.
\<close>
lemma N_le_N_1: "N n \<le> N 1"
  by (rule N_dvd_mono) auto

text \<open>
  Primes have relatively large norms, almost reaching the norm of 1:
\<close>
lemma N_prime:
  assumes "prime p"
  shows   "N p = N 1 - 1 / q ^ nat p"
proof (rule sums_unique2)
  define p' where "p' = nat p"
  have p: "p = int p'"
    using assms by (auto simp: p'_def prime_ge_0_int)
  have "prime p'"
    using assms by (simp add: p)

  have "(\<lambda>k. if k = 0 \<or> int k dvd p then 0 else 1 / q ^ k) sums N p"
    by (rule N_sums)
  also have "int k dvd p \<longleftrightarrow> k \<in> {1, p'}" for k
    using assms by (auto simp: p prime_nat_iff)
  hence "(\<lambda>k. if k = 0 \<or> int k dvd p then 0 else 1 / q ^ k) =
         (\<lambda>k. if k \<in> {0, 1, p'} then 0 else (1 / q) ^ k)"
    using assms q_gt_1 by (simp add: power_divide cong: if_cong)
  finally show "\<dots> sums N p" .

  have "(\<lambda>k. if k \<in> {0, 1, p'} then 0 else (1 / q) ^ k) sums
                 (1 / (1 - 1 / q) + (- (1 / q) - (1 / q) ^ p' - 1))"
    by (rule sums_If_finite_set'[OF geometric_sums])
       (use \<open>prime p'\<close> q_gt_1 prime_gt_Suc_0_nat[of p'] in \<open>auto simp: \<close>)
  also have "\<dots> = N 1 - 1 / q ^ p'"
    using q_gt_1 by (simp add: field_simps N_1)
  finally show "(\<lambda>k. if k \<in> {0, 1, p'} then 0 else (1 / q) ^ k) sums \<dots>" .
qed

lemma N_2: "N 2 = 1 / (q ^ 2 * (q - 1))"
  using q_gt_1 by (auto simp: N_prime N_1 field_simps power2_eq_square)

lemma N_less_N_1:
  assumes "n \<noteq> 1" "n \<noteq> -1"
  shows   "N n < N 1"
proof (cases "n = 0")
  case False
  then obtain p where p: "prime p" "p dvd n"
    using prime_divisor_exists[of n] assms by force
  hence "N n \<le> N p" by (intro N_dvd_mono)
  also from p have "N p < N 1"
    using q_gt_1 by (simp add: N_prime)
  finally show ?thesis .
qed (use q_gt_1 in \<open>auto simp: N_1\<close>)

text \<open>
  Composites, on the other hand, do not achieve this:
\<close>
lemma nonprime_imp_N_lt:
  assumes "\<not>prime_elem n" "\<bar>n\<bar> \<noteq> 1" "n \<noteq> 0"
  shows   "N n < N 1 - 1 / q ^ nat \<bar>n\<bar>"
proof -
  obtain p where p: "prime p" "p dvd n"
    using prime_divisor_exists[of n] assms by auto
  define p' where "p' = nat p"
  have p': "p = int p'"
    using p by (auto simp: p'_def prime_ge_0_int)
  have "prime p'"
    using p by (simp add: p')

  define n' where "n' = nat \<bar>n\<bar>"
  have "n' > 1"
    using assms by (auto simp: n'_def)

  have "N n \<le> 1 / (q * (q - 1)) - 1 / q ^ p' - 1 / q ^ n'"
  proof (rule sums_le)
    show "(\<lambda>k. if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k) sums N n"
      by (rule N_sums)
  next
    from assms p have "n' \<noteq> p'"
      by (auto simp: n'_def p'_def nat_eq_iff)
    hence "(\<lambda>k. if k \<in> {0, 1, p', n'} then 0 else (1 / q) ^ k) sums
                   (1 / (1 - 1 / q) + (- (1 / q) - (1 / q) ^ p' - (1 / q) ^ n' - 1))"
      by (intro sums_If_finite_set'[OF geometric_sums])
         (use \<open>prime p'\<close> q_gt_1 prime_gt_Suc_0_nat[of p'] \<open>n' > 1\<close> in \<open>auto simp: \<close>)
    also have "\<dots> = 1 / (q * (q - 1)) - 1 / q ^ p' - 1 / q ^ n'"
      using q_gt_1 by (simp add: field_simps)
    finally show "(\<lambda>k. if k \<in> {0, 1, p', n'} then 0 else (1 / q) ^ k) sums \<dots>" .
  next
    show "\<And>k. (if k = 0 \<or> int k dvd n then 0 else 1 / q ^ k)
         \<le> (if k \<in> {0, 1, p', n'} then 0 else (1 / q) ^ k)"
      using q_gt_1 p by (auto simp: p'_def n'_def power_divide)
  qed
  also have "\<dots> < 1 / (q * (q - 1)) - 1 / q ^ n'"
    using q_gt_1 by simp
  finally show ?thesis by (simp add: n'_def N_1)
qed

text \<open>
  This implies that one can use the norm as a primality test:
\<close>
lemma prime_iff_N_eq:
  assumes "n \<noteq> 0"
  shows   "prime_elem n \<longleftrightarrow> N n = N 1 - 1 / q ^ nat \<bar>n\<bar>"
proof -
  have *: "prime_elem n \<longleftrightarrow> N n = N 1 - 1 / q ^ nat \<bar>n\<bar>" if "n > 0" for n
  proof -
    consider "n = 1" | "prime n" | "\<not>prime n" "n > 1"
      using \<open>n > 0\<close> by force
    thus ?thesis
    proof cases
      assume "n = 1"
      thus ?thesis using q_gt_1
        by (auto simp: N_1)
    next
      assume n: "\<not>prime n" "n > 1"
      with nonprime_imp_N_lt[of n] show ?thesis by simp
    qed (auto simp: N_prime prime_ge_0_int)
  qed

  show ?thesis
  proof (cases "n > 0")
    case True
    with * show ?thesis by blast
  next
    case False
    with *[of "-n"] assms show ?thesis by simp
  qed
qed

text \<open>
  Factorials, on the other hand, have very small norms:
\<close>
lemma N_fact_le: "N (fact m) \<le> 1 / (q - 1) * 1 / q ^ m"
proof (rule sums_le[OF _ N_sums])
  have "(\<lambda>k. 1 / q ^ k / q ^ Suc m) sums (q / (q - 1) / q ^ Suc m)"
    using geometric_sums[of "1 / q"] q_gt_1
    by (intro sums_divide) (auto simp: field_simps)
  also have "(q / (q - 1) / q ^ Suc m) = 1 / (q - 1) * 1 / q ^ m"
    using q_gt_1 by (simp add: field_simps)
  also have "(\<lambda>k. 1 / q ^ k / q ^ Suc m) = (\<lambda>k. 1 / q ^ (k + Suc m))"
    using q_gt_1 by (simp add: field_simps power_add)
  also have "\<dots> = (\<lambda>k. if k + Suc m \<le> m then 0 else 1 / q ^ (k + Suc m))"
    by auto
  finally have "\<dots> sums (1 / (q - 1) * 1 / q ^ m)" .
  also have "?this \<longleftrightarrow> (\<lambda>k. if k \<le> m then 0 else 1 / q ^ k) sums (1 / (q - 1) * 1 / q ^ m)"
    by (rule sums_zero_iff_shift) auto
  finally show \<dots> .
next
  fix k :: nat
  have "int k dvd fact m" if "k > 0" "k \<le> m"
  proof -
    have "int k dvd int (fact m)"
      unfolding int_dvd_int_iff using that by (simp add: dvd_fact)
    thus "int k dvd fact m"
      unfolding of_nat_fact by simp
  qed
  thus "(if k = 0 \<or> int k dvd fact m then 0 else 1 / q ^ k) \<le>
        (if k \<le> m then 0 else 1 / q ^ k)" using q_gt_1 by auto
qed

lemma N_prime_mono:
  assumes "prime p" "prime p'" "p \<le> p'"
  shows   "N p \<le> N p'"
  using assms q_gt_1 by (auto simp add: N_prime field_simps nat_le_iff prime_ge_0_int)

lemma N_prime_ge:
  assumes "prime p"
  shows   "N p \<ge> 1 / (q\<^sup>2 * (q - 1))"
proof -
  have "1 / (q ^ 2 * (q - 1)) = N 2"
    using q_gt_1 by (auto simp: N_prime N_1 field_simps power2_eq_square)
  also have "\<dots> \<le> N p"
    using assms by (intro N_prime_mono) (auto simp: prime_ge_2_int)
  finally show ?thesis .
qed

lemma N_prime_elem_ge:
  assumes "prime_elem p"
  shows   "N p \<ge> 1 / (q\<^sup>2 * (q - 1))"
proof (cases "p \<ge> 0")
  case True
  with assms N_prime_ge show ?thesis by auto
next
  case False
  with assms N_prime_ge[of "-p"] show ?thesis by auto
qed

text \<open>
  Next, we use this norm to derive a metric:
\<close>

lift_definition dist :: "fbint \<Rightarrow> fbint \<Rightarrow> real" is
  "\<lambda>x y. N (x - y)" .

lemma dist_self [simp]: "dist x x = 0"
  by transfer simp

lemma dist_sym [simp]: "dist x y = dist y x"
  by transfer (simp add: N_minus_commute)

lemma dist_pos: "x \<noteq> y \<Longrightarrow> dist x y > 0"
  by transfer (use N_pos in simp)

lemma dist_eq_0_iff [simp]: "dist x y = 0 \<longleftrightarrow> x = y"
  using dist_pos[of x y] by (cases "x = y") auto

lemma dist_triangle_ineq: "dist x z \<le> dist x y + dist y z"
proof transfer
  fix x y z :: int
  show "N (x - z) \<le> N (x - y) + N (y - z)"
    using N_triangle_ineq[of "x - y" "y - z"] by simp
qed

text \<open>
  Lastly, we show that the metric we defined indeed induces the Furstenberg topology.
\<close>
theorem dist_induces_open:
  "open U \<longleftrightarrow> (\<forall>x\<in>U. \<exists>e>0. \<forall>y. dist x y < e \<longrightarrow> y \<in> U)"
proof (transfer, safe)
  fix U :: "int set" and x :: int
  assume *: "\<forall>x\<in>U. \<exists>b>0. arith_prog x b \<subseteq> U"
  assume "x \<in> U"
  with * obtain b where b: "b > 0" "arith_prog x b \<subseteq> U" by blast
  define e where "e = 1 / q ^ b"

  show "\<exists>e>0. \<forall>y. N (x - y) < e \<longrightarrow> y \<in> U"
  proof (rule exI; safe?)
    show "e > 0" using q_gt_1 by (simp add: e_def)
  next
    fix y assume "N (x - y) < e"
    also have "\<dots> = 1 / q ^ b" by fact
    finally have "b dvd (x - y)"
      by (rule N_lt_imp_dvd) fact
    hence "y \<in> arith_prog x b"
      by (auto simp: arith_prog_def cong_iff_dvd_diff dvd_diff_commute)
    with b show "y \<in> U" by blast
  qed

next

  fix U :: "int set" and x :: int
  assume *: "\<forall>x\<in>U. \<exists>e>0. \<forall>y. N (x - y) < e \<longrightarrow> y \<in> U"
  assume "x \<in> U"
  with * obtain e where e: "e > 0" "\<forall>y. N (x - y) < e \<longrightarrow> y \<in> U" by blast
  have "eventually (\<lambda>N. 1 / (q - 1) * 1 / q ^ N < e) at_top"
    using q_gt_1 \<open>e > 0\<close> by real_asymp
  then obtain m where m: "1 / (q - 1) * 1 / q ^ m < e"
    by (auto simp: eventually_at_top_linorder)
  define b :: nat where "b = fact m"

  have "arith_prog x b \<subseteq> U"
  proof
    fix y assume "y \<in> arith_prog x b"
    show "y \<in> U"
    proof (cases "y = x")
      case False
      from \<open>y \<in> arith_prog x b\<close> obtain n where y: "y = x + int b * n"
        by (auto simp: arith_prog_altdef)
      from y and \<open>y \<noteq> x\<close> have [simp]: "n \<noteq> 0" by auto
      have "N (x - y) = N (int b * n)" by (simp add: y)
      also have "\<dots> \<le> N (int b)"
        by (rule N_dvd_mono) auto
      also have "\<dots> \<le> 1 / (q - 1) * 1 / q ^ m"
        using N_fact_le by (simp add: b_def)
      also have "\<dots> < e" by fact
      finally show "y \<in> U" using e by auto
    qed (use \<open>x \<in> U\<close> in auto)
  qed
  moreover have "b > 0" by (auto simp: b_def)
  ultimately show "\<exists>b>0. arith_prog x b \<subseteq> U"
    by blast
qed

end

text \<open>
  We now show that the Furstenberg space is a metric space with this metric (with \<open>q = 2\<close>),
  which essentially only amounts to plugging together all the results from above.
\<close>

interpretation fb: fbnorm 2
  by standard auto

instantiation fbint :: dist
begin

definition dist_fbint where "dist_fbint = fb.dist"

instance ..

end

instantiation fbint :: uniformity_dist
begin

definition uniformity_fbint :: "(fbint \<times> fbint) filter" where
  "uniformity_fbint = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"

instance by standard (simp add: uniformity_fbint_def)

end

instance fbint :: open_uniformity
proof
  fix U :: "fbint set"
  show "open U = (\<forall>x\<in>U. eventually (\<lambda>(x',y). x' = x \<longrightarrow> y \<in> U) uniformity)"
    unfolding eventually_uniformity_metric dist_fbint_def
    using fb.dist_induces_open by simp
qed

instance fbint :: metric_space
  by standard (use fb.dist_triangle_ineq in \<open>auto simp: dist_fbint_def\<close>)

text \<open>
  In particular, we can now show that the sequence \<open>n!\<close> tends to 0 in the Furstenberg topology:
\<close>
lemma tendsto_fbint_fact: "(\<lambda>n. fbint (fact n)) \<longlonglongrightarrow> fbint 0"
proof -
  have "(\<lambda>n. dist (fbint (fact n)) (fbint 0)) \<longlonglongrightarrow> 0"
  proof (rule tendsto_sandwich[OF always_eventually always_eventually]; safe?)
    fix n :: nat
    show "dist (fbint (fact n)) (fbint 0) \<le> 1 / 2 ^ n"
      unfolding dist_fbint_def by (transfer fixing: n) (use fb.N_fact_le[of n] in simp)
    show "dist (fbint (fact n)) (fbint 0) \<ge> 0"
      by simp
    show "(\<lambda>n. 1 / 2 ^ n :: real) \<longlonglongrightarrow> 0"
      by real_asymp
  qed simp_all
  thus ?thesis
    using tendsto_dist_iff by metis
qed

end


(*  Title:      HOL/Lattice/Orders.thy
    Author:     Markus Wenzel, TU Muenchen
*)

section \<open>Orders\<close>

theory Orders imports Main begin

subsection \<open>Ordered structures\<close>

text \<open>
  We define several classes of ordered structures over some type @{typ
  'a} with relation \<open>\<sqsubseteq> :: 'a \<Rightarrow> 'a \<Rightarrow> bool\<close>.  For a
  \emph{quasi-order} that relation is required to be reflexive and
  transitive, for a \emph{partial order} it also has to be
  anti-symmetric, while for a \emph{linear order} all elements are
  required to be related (in either direction).
\<close>

class leq =
  fixes leq :: "'a \<Rightarrow> 'a \<Rightarrow> bool"  (infixl "\<sqsubseteq>" 50)

class quasi_order = leq +
  assumes leq_refl [intro?]: "x \<sqsubseteq> x"
  assumes leq_trans [trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"

class partial_order = quasi_order +
  assumes leq_antisym [trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x = y"

class linear_order = partial_order +
  assumes leq_linear: "x \<sqsubseteq> y \<or> y \<sqsubseteq> x"

lemma linear_order_cases:
    "((x::'a::linear_order) \<sqsubseteq> y \<Longrightarrow> C) \<Longrightarrow> (y \<sqsubseteq> x \<Longrightarrow> C) \<Longrightarrow> C"
  by (insert leq_linear) blast

subsection \<open>Duality\<close>

text \<open>
  The \emph{dual} of an ordered structure is an isomorphic copy of the
  underlying type, with the \<open>\<sqsubseteq>\<close> relation defined as the inverse
  of the original one.
\<close>

datatype 'a dual = dual 'a

primrec undual :: "'a dual \<Rightarrow> 'a" where
  undual_dual: "undual (dual x) = x"

instantiation dual :: (leq) leq
begin

definition
  leq_dual_def: "x' \<sqsubseteq> y' \<equiv> undual y' \<sqsubseteq> undual x'"

instance ..

end

lemma undual_leq [iff?]: "(undual x' \<sqsubseteq> undual y') = (y' \<sqsubseteq> x')"
  by (simp add: leq_dual_def)

lemma dual_leq [iff?]: "(dual x \<sqsubseteq> dual y) = (y \<sqsubseteq> x)"
  by (simp add: leq_dual_def)

text \<open>
  \medskip Functions @{term dual} and @{term undual} are inverse to
  each other; this entails the following fundamental properties.
\<close>

lemma dual_undual [simp]: "dual (undual x') = x'"
  by (cases x') simp

lemma undual_dual_id [simp]: "undual o dual = id"
  by (rule ext) simp

lemma dual_undual_id [simp]: "dual o undual = id"
  by (rule ext) simp

text \<open>
  \medskip Since @{term dual} (and @{term undual}) are both injective
  and surjective, the basic logical connectives (equality,
  quantification etc.) are transferred as follows.
\<close>

lemma undual_equality [iff?]: "(undual x' = undual y') = (x' = y')"
  by (cases x', cases y') simp

lemma dual_equality [iff?]: "(dual x = dual y) = (x = y)"
  by simp

lemma dual_ball [iff?]: "(\<forall>x \<in> A. P (dual x)) = (\<forall>x' \<in> dual ` A. P x')"
proof
  assume a: "\<forall>x \<in> A. P (dual x)"
  show "\<forall>x' \<in> dual ` A. P x'"
  proof
    fix x' assume x': "x' \<in> dual ` A"
    have "undual x' \<in> A"
    proof -
      from x' have "undual x' \<in> undual ` dual ` A" by simp
      thus "undual x' \<in> A" by (simp add: image_comp)
    qed
    with a have "P (dual (undual x'))" ..
    also have "\<dots> = x'" by simp
    finally show "P x'" .
  qed
next
  assume a: "\<forall>x' \<in> dual ` A. P x'"
  show "\<forall>x \<in> A. P (dual x)"
  proof
    fix x assume "x \<in> A"
    hence "dual x \<in> dual ` A" by simp
    with a show "P (dual x)" ..
  qed
qed

lemma range_dual [simp]: "surj dual"
proof -
  have "\<And>x'. dual (undual x') = x'" by simp
  thus "surj dual" by (rule surjI)
qed

lemma dual_all [iff?]: "(\<forall>x. P (dual x)) = (\<forall>x'. P x')"
proof -
  have "(\<forall>x \<in> UNIV. P (dual x)) = (\<forall>x' \<in> dual ` UNIV. P x')"
    by (rule dual_ball)
  thus ?thesis by simp
qed

lemma dual_ex: "(\<exists>x. P (dual x)) = (\<exists>x'. P x')"
proof -
  have "(\<forall>x. \<not> P (dual x)) = (\<forall>x'. \<not> P x')"
    by (rule dual_all)
  thus ?thesis by blast
qed

lemma dual_Collect: "{dual x| x. P (dual x)} = {x'. P x'}"
proof -
  have "{dual x| x. P (dual x)} = {x'. \<exists>x''. x' = x'' \<and> P x''}"
    by (simp only: dual_ex [symmetric])
  thus ?thesis by blast
qed

subsection \<open>Transforming orders\<close>

subsubsection \<open>Duals\<close>

text \<open>
  The classes of quasi, partial, and linear orders are all closed
  under formation of dual structures.
\<close>

instance dual :: (quasi_order) quasi_order
proof
  fix x' y' z' :: "'a::quasi_order dual"
  have "undual x' \<sqsubseteq> undual x'" .. thus "x' \<sqsubseteq> x'" ..
  assume "y' \<sqsubseteq> z'" hence "undual z' \<sqsubseteq> undual y'" ..
  also assume "x' \<sqsubseteq> y'" hence "undual y' \<sqsubseteq> undual x'" ..
  finally show "x' \<sqsubseteq> z'" ..
qed

instance dual :: (partial_order) partial_order
proof
  fix x' y' :: "'a::partial_order dual"
  assume "y' \<sqsubseteq> x'" hence "undual x' \<sqsubseteq> undual y'" ..
  also assume "x' \<sqsubseteq> y'" hence "undual y' \<sqsubseteq> undual x'" ..
  finally show "x' = y'" ..
qed

instance dual :: (linear_order) linear_order
proof
  fix x' y' :: "'a::linear_order dual"
  show "x' \<sqsubseteq> y' \<or> y' \<sqsubseteq> x'"
  proof (rule linear_order_cases)
    assume "undual y' \<sqsubseteq> undual x'"
    hence "x' \<sqsubseteq> y'" .. thus ?thesis ..
  next
    assume "undual x' \<sqsubseteq> undual y'"
    hence "y' \<sqsubseteq> x'" .. thus ?thesis ..
  qed
qed

subsubsection \<open>Binary products \label{sec:prod-order}\<close>

text \<open>
  The classes of quasi and partial orders are closed under binary
  products.  Note that the direct product of linear orders need
  \emph{not} be linear in general.
\<close>

instantiation prod :: (leq, leq) leq
begin

definition
  leq_prod_def: "p \<sqsubseteq> q \<equiv> fst p \<sqsubseteq> fst q \<and> snd p \<sqsubseteq> snd q"

instance ..

end

lemma leq_prodI [intro?]:
    "fst p \<sqsubseteq> fst q \<Longrightarrow> snd p \<sqsubseteq> snd q \<Longrightarrow> p \<sqsubseteq> q"
  by (unfold leq_prod_def) blast

lemma leq_prodE [elim?]:
    "p \<sqsubseteq> q \<Longrightarrow> (fst p \<sqsubseteq> fst q \<Longrightarrow> snd p \<sqsubseteq> snd q \<Longrightarrow> C) \<Longrightarrow> C"
  by (unfold leq_prod_def) blast

instance prod :: (quasi_order, quasi_order) quasi_order
proof
  fix p q r :: "'a::quasi_order \<times> 'b::quasi_order"
  show "p \<sqsubseteq> p"
  proof
    show "fst p \<sqsubseteq> fst p" ..
    show "snd p \<sqsubseteq> snd p" ..
  qed
  assume pq: "p \<sqsubseteq> q" and qr: "q \<sqsubseteq> r"
  show "p \<sqsubseteq> r"
  proof
    from pq have "fst p \<sqsubseteq> fst q" ..
    also from qr have "\<dots> \<sqsubseteq> fst r" ..
    finally show "fst p \<sqsubseteq> fst r" .
    from pq have "snd p \<sqsubseteq> snd q" ..
    also from qr have "\<dots> \<sqsubseteq> snd r" ..
    finally show "snd p \<sqsubseteq> snd r" .
  qed
qed

instance prod :: (partial_order, partial_order) partial_order
proof
  fix p q :: "'a::partial_order \<times> 'b::partial_order"
  assume pq: "p \<sqsubseteq> q" and qp: "q \<sqsubseteq> p"
  show "p = q"
  proof
    from pq have "fst p \<sqsubseteq> fst q" ..
    also from qp have "\<dots> \<sqsubseteq> fst p" ..
    finally show "fst p = fst q" .
    from pq have "snd p \<sqsubseteq> snd q" ..
    also from qp have "\<dots> \<sqsubseteq> snd p" ..
    finally show "snd p = snd q" .
  qed
qed

subsubsection \<open>General products \label{sec:fun-order}\<close>

text \<open>
  The classes of quasi and partial orders are closed under general
  products (function spaces).  Note that the direct product of linear
  orders need \emph{not} be linear in general.
\<close>

instantiation "fun" :: (type, leq) leq
begin

definition
  leq_fun_def: "f \<sqsubseteq> g \<equiv> \<forall>x. f x \<sqsubseteq> g x"

instance ..

end

lemma leq_funI [intro?]: "(\<And>x. f x \<sqsubseteq> g x) \<Longrightarrow> f \<sqsubseteq> g"
  by (unfold leq_fun_def) blast

lemma leq_funD [dest?]: "f \<sqsubseteq> g \<Longrightarrow> f x \<sqsubseteq> g x"
  by (unfold leq_fun_def) blast

instance "fun" :: (type, quasi_order) quasi_order
proof
  fix f g h :: "'a \<Rightarrow> 'b::quasi_order"
  show "f \<sqsubseteq> f"
  proof
    fix x show "f x \<sqsubseteq> f x" ..
  qed
  assume fg: "f \<sqsubseteq> g" and gh: "g \<sqsubseteq> h"
  show "f \<sqsubseteq> h"
  proof
    fix x from fg have "f x \<sqsubseteq> g x" ..
    also from gh have "\<dots> \<sqsubseteq> h x" ..
    finally show "f x \<sqsubseteq> h x" .
  qed
qed

instance "fun" :: (type, partial_order) partial_order
proof
  fix f g :: "'a \<Rightarrow> 'b::partial_order"
  assume fg: "f \<sqsubseteq> g" and gf: "g \<sqsubseteq> f"
  show "f = g"
  proof
    fix x from fg have "f x \<sqsubseteq> g x" ..
    also from gf have "\<dots> \<sqsubseteq> f x" ..
    finally show "f x = g x" .
  qed
qed

end


theory Practical
imports Main
begin

(***************************First-order logic*************************************)

(*1 mark*)
lemma "A\<or>A \<longrightarrow> A"
  apply (rule impI)
  apply (erule disjE)
   apply assumption+
  done

(*1 mark*)
lemma "(P\<longrightarrow>R)\<longrightarrow>(\<not>P\<or>R)"
  apply (rule impI)
  apply (rule ccontr)
  apply (erule impE)
   apply (rule ccontr)
   apply (erule notE)
   apply (rule disjI1)
   apply assumption
  apply (erule notE)
  apply (rule disjI2)
  apply assumption
  done

(*1 mark*)
lemma "(P\<and>Q\<longrightarrow>R)\<longrightarrow>P\<longrightarrow>Q\<longrightarrow>R"
  apply (rule impI)+
  apply (erule impE)
   apply (rule conjI)
    apply assumption+
  done

(*3 marks*)
lemma "\<not>\<not>P \<or> \<not>P"
  apply (rule classical)
  apply (rule disjI2)
  apply (rule classical)
  apply (erule notE)
  apply (rule disjI1)
  apply assumption
  done

(*4 marks*)
lemma "(P\<or>R)\<longleftrightarrow>(\<not>(\<not>P\<and> \<not>R))"
  apply (rule iffI)
   apply (rule notI)
   apply (erule disjE)
    apply (erule conjE)
    apply (erule notE)
    apply assumption
   apply (erule conjE)
   apply (erule_tac P = "R" in notE)
   apply assumption
  apply (rule ccontr)
  apply (erule notE)
  apply (rule conjI)
   apply (rule notI)
   apply (erule notE)
   apply (rule disjI1)
   apply assumption
  apply (rule notI)
  apply (erule notE)
  apply (rule disjI2)
  apply assumption
  done

(*1 mark*)
(* First version theory file lemma *)
lemma "(\<forall> x . F x \<longrightarrow> G x ) \<longrightarrow> \<not> (\<exists> x . F x \<and> \<not> G x )"
  apply (rule impI)
  apply (rule notI)
  apply (erule exE)
  apply (erule allE)
  apply (erule impE)
   apply (erule conjE)
   apply assumption
  apply (erule conjE)
  apply (erule notE)
  apply assumption
  done

(* Updated lemma in handout *)
lemma "(\<forall> x . F x) \<and> (\<forall> x . G x ) \<longrightarrow> (\<forall> x . F x \<and> G x )"
  apply (rule impI)
  apply (rule allI)
  apply (erule conjE)
  apply (rule conjI)
   apply (erule allE, assumption)+
  done

(*1 mark*)
lemma "(\<forall> x y. R x y) \<longrightarrow> (\<forall> x . R x x )"
  apply (rule impI)
  apply (rule allI)
  apply (erule allE)+
  apply assumption
  done

(*3 marks*)
lemma "(\<forall>x. P x)\<or>(\<exists>x.\<not>P x)"
  apply (rule classical)
  apply (rule disjI1)
  apply (rule allI)
  apply (rule classical)
  apply (erule notE)
  apply (rule disjI2)
  apply (rule exI)
  apply assumption
  done

(*3 marks*)
lemma "(\<forall>x. \<not> (P x \<longrightarrow> Q x)) \<longrightarrow> \<not>(\<exists>x. \<not>P x \<and> Q x)"
  apply (rule impI)
  apply (rule notI)
  apply (erule exE)
  apply (erule allE)
  apply (erule notE)
  apply (rule impI)
  apply (erule conjE)
  apply assumption
  done

(*3 marks*)
lemma "\<exists>Bob. (drunk Bob \<longrightarrow> (\<forall>y. drunk y))"
 apply (rule classical)
  apply (rule exI)
  apply (rule impI)
  apply (rule allI)
  apply (erule notE)
  apply (rule classical)
  apply (rule exI)
  apply (rule impI)
  apply (rule allI)
  apply (rule classical)
  apply (erule notE)
  apply (rule exI)
  apply (rule impI)
  apply (rule allI)
  apply (erule notE)
  apply assumption
  done

(*4 marks*)
lemma "\<not> (\<exists> barber . man barber \<and> (\<forall> x . man x \<and> \<not>shaves x x \<longleftrightarrow> shaves barber x ))"
  apply (rule notI)
  apply (erule exE)
  apply (erule conjE)
  apply (erule allE)
  apply (erule iffE)
  apply (erule impE)
   apply (rule conjI)
    apply assumption
   apply (rule notI)
   apply (erule impE, assumption, erule conjE, erule notE, assumption)+
  done

locale incidence =
  fixes incidence_points_on_sections :: "'point \<Rightarrow> 'section \<Rightarrow> bool" (infix " \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t " 80)
  fixes region_to_section :: "'region \<Rightarrow> 'section"
(*Write here your axiom stating that every section has a point incident to it*) (*2 marks*)
  assumes section_nonempty: "\<forall>s. \<exists>P. P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s"
(*Write here your axiom stating that two sections are the same if the same points are
incident to each*) (*2 marks*)
  and section_uniqueness: "\<forall>s1 s2. (\<forall>P. (P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s1 \<longleftrightarrow> P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s2)) \<longrightarrow> s1 = s2"

begin

definition isPartOf ::"'section \<Rightarrow> 'section \<Rightarrow> bool" (infix "isPartOf" 80) where
(*write your formalisation of definition D1 here*) (*1 mark*)
"s1 isPartOf s2 \<equiv> \<forall>P. (P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s1 \<longrightarrow> P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s2)"

definition inclusion ::"'region \<Rightarrow> 'section \<Rightarrow> bool"(infix "isIncludedIn" 80) where
(*write your formalisation of definition D2 here*) (*1 mark*)
"R isIncludedIn s \<equiv> (region_to_section R) isPartOf s"

definition overlaps ::"'region \<Rightarrow> 'section \<Rightarrow> bool"(infix "overlaps" 80) where
(*write your formalisation of definition D3 here*) (*1 mark*)
" R overlaps s \<equiv> \<exists>P. P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t (region_to_section R) \<and> P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t s"

lemma region_overlaps_itself: "R overlaps (region_to_section R)"
(*Write your structured proof here*) (*2 marks*)
proof (unfold overlaps_def)
  have incidence: "\<exists>P. P \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t region_to_section R"
    by (simp add: section_nonempty)
  show "\<exists>P. P  \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t  region_to_section R \<and> P  \<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t  region_to_section R" using incidence
    by auto
qed

(*Formalise and prove that isPartOf is reflexive, transitive and antisymmetric*) (*3 marks*)
lemma isPartOf_reflexive: "s isPartOf s"
(*Formalise and prove that isPartOf is reflexive here*)
  by (simp add: isPartOf_def)

lemma isPartOf_transitive: "(s1 isPartOf s2 \<and> s2 isPartOf s3) \<longrightarrow> s1 isPartOf s3"
(*Formalise and prove that isPartOf is transitive here*)
  by (simp add: isPartOf_def)

lemma isPartOf_antisymmetric: "(s1 isPartOf s2 \<and> s2 isPartOf s1) \<longrightarrow> s1 = s2"
(*Formalise and prove that isPartOf is antisymmetric here*)
  using isPartOf_def section_uniqueness by blast
end

locale section_bundles =  incidence incidence_points_on_sections region_to_section
  for  incidence_points_on_sections :: "'point \<Rightarrow> 'section \<Rightarrow> bool"
  and region_to_section :: "'region \<Rightarrow> 'section" +
  fixes crossing :: "'region \<Rightarrow> 'section \<Rightarrow> bool"
  and incidence_sections_on_bundles :: "'section \<Rightarrow> 'bundle \<Rightarrow> bool" (infix "\<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n" 80)
(*Write your formalisation of Axiom SC1 here*) (*1 mark*)
  assumes SC1: "\<forall>s R. (crossing R s) \<longrightarrow> (R overlaps s)"
(*Write your formalisation of Axiom SI1 here*)     (*1 mark*)
 and SI1: "\<forall>s b1 b2. (s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b1 \<longleftrightarrow> s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b2) \<longrightarrow> (b1 = b2)"

begin

definition atLeastAsRestrictiveAs :: "'section \<Rightarrow> 'bundle \<Rightarrow> 'section \<Rightarrow> bool" where
(*Write your formalisation of atLeastAsRestrictiveAs here*) (*1 mark*)
"atLeastAsRestrictiveAs s1 b s2 \<equiv> (s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> s2 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> s1 isPartOf s2)"

notation
  atLeastAsRestrictiveAs ("_ \<le>\<^sub>_ _" [80, 80, 80] 80)

(*Formalise and prove that isPartOf is reflexive, transitive and antisymmetric*) (*2 marks*)

(*Kulik and Eschenbach say 'The relation \<ge> is reflexive, transitive and antisymmetric for a given
sector bundle.' So, do they mean, given that the sections under consideration are in the bundle?
This is what we assume for reflexivity.*)
lemma atLeastAsRestrictiveAs_reflexive:
  assumes "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"  shows "s \<le>\<^sub>b s"
(*Add your proof here*)
  by (simp add: assms atLeastAsRestrictiveAs_def isPartOf_reflexive)

lemma atLeastAsRestrictiveAs_transitive:
(*Formalise and prove that atLeastAsRestrictiveAs is transitive*)
  assumes "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" shows "(s1 \<le>\<^sub>b s2 \<and> s2 \<le>\<^sub>b s3) \<longrightarrow> (s1 \<le>\<^sub>b s3)"
  using atLeastAsRestrictiveAs_def isPartOf_transitive by blast

lemma atLeastAsRestrictiveAs_antisymmetric:
(*Formalise and prove that atLeastAsRestrictiveAs is antisymmetric*)
  assumes "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" shows "(s1 \<le>\<^sub>b s2 \<and> s2 \<le>\<^sub>b s1) \<longrightarrow> (s1 = s2)"
  by (simp add: atLeastAsRestrictiveAs_def isPartOf_antisymmetric)

end

locale comparison = section_bundles incidence_points_on_sections region_to_section
 crossing incidence_sections_on_bundles
  for  incidence_points_on_sections :: "'point \<Rightarrow> 'section \<Rightarrow> bool" (infix "\<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t" 80)
  and region_to_section :: "'region \<Rightarrow> 'section"
  and crossing :: "'region \<Rightarrow> 'section \<Rightarrow> bool" (infix "crosses" 80)
  and incidence_sections_on_bundles :: "'section \<Rightarrow> 'bundle \<Rightarrow> bool" (infix "\<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n" 80)+
(*Write your formalisation of Axiom SB2 here*) (*1 mark*)
assumes SB2: "\<forall>b s1 s2. (s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> s2 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b) \<longrightarrow> (s1 \<le>\<^sub>b s2 \<or> s2 \<le>\<^sub>b s1)"

begin

(*Write your formalisation and proof of Theorem T1 here*) (*1 mark*)
lemma T1: "\<forall>b s1 R. (R overlaps s1) \<longrightarrow> (\<forall>s2. (s1 \<le>\<^sub>b s2) \<longrightarrow> (R overlaps s2))"
  using atLeastAsRestrictiveAs_def isPartOf_def overlaps_def by auto

(*Write your formalisation and proof of Theorem T2 here*) (*1 mark*)
lemma T2: "\<forall>b s1 R. (R isIncludedIn s1) \<longrightarrow> (\<forall>s2. (s1 \<le>\<^sub>b s2) \<longrightarrow> (R isIncludedIn s2))"
  using atLeastAsRestrictiveAs_def inclusion_def isPartOf_transitive by blast

definition isCore (infix "isCoreOf" 80) where
"s isCoreOf b = (s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> (\<forall>s'. s' \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> s \<le>\<^sub>b s'))"

(*Write your definition of hull here*) (*1 mark*)
definition isHull (infix "isHull" 80) where
"s isHull b = (s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> (\<forall>s'. s' \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> s' \<le>\<^sub>b s))"

end

locale crossing_sector = comparison incidence_points_on_sections
          region_to_section crossing incidence_sections_on_bundles
          for incidence_points_on_sections :: "'point \<Rightarrow> 'section \<Rightarrow> bool" (infix "\<iota>\<^sub>p\<^sub>o\<^sub>i\<^sub>n\<^sub>t" 80)
and region_to_section :: "'region \<Rightarrow> 'section"
and crossing :: "'region \<Rightarrow> 'section \<Rightarrow> bool" (infix "crosses" 80)
and incidence_sections_on_bundles :: "'section \<Rightarrow> 'bundle \<Rightarrow> bool" (infix "\<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n" 80) +
(*Write your formalisation of Axiom SC2 here*) (*1 mark*)
assumes SC2: "\<forall>b s1 R. (R crosses s1) \<longrightarrow> (\<forall>s2. (s2 \<le>\<^sub>b s1) \<longrightarrow> (R crosses s2))"
begin

(****************************)
(*Write your formalisation and structured proof of the remark 'If a region
overlaps the core of a section bundle then it overlaps every section of the section bundle'*)
(*4 marks*)
lemma overlaps_core:
  assumes core: "s1 isCoreOf b" and overlap: "R overlaps s1"
  shows "\<forall>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> R overlaps s"
proof (rule allI, rule impI)
  fix s
  assume "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
  then have "s1 \<le>\<^sub>b s"
    using core isCore_def by blast
  then show "R overlaps s"
    using overlap T1 by blast
qed

(*
We have that section s is core of bundle b, and region R overlaps s.
We showed that s is a section of b, by the definition of core (which says that this section contains
all sections in the bundle.
We need to show that for all sections of the bundle (part of the bundle), we have that R overlaps
all these sections from the theorems we proved previously (core_region)
 *)

(*Write your formalisation and structured proof of the remark `If a region
crosses the hull of a section bundle then it crosses every sector of the section bundle'*)
(*4 marks*)
lemma crosses_hull:
  assumes hull: "s1 isHull b" and cross: "R crosses s1"
  shows "\<forall>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> R crosses s"
proof (rule allI, rule impI)
  fix s
  assume "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
  then have "s \<le>\<^sub>b s1"
    using hull isHull_def by blast
  then show "R crosses s"
    using cross SC2 by blast
qed

(*Write your formalisation and structured proof of the remark `If a region
does not overlap the hull of a section bundle, it does not overlap any of its sections'*)
(*4 marks*)
lemma not_overlap_hull:
  assumes hull: "s1 isHull b" and not_overlaps: "\<not>(R overlaps s1)" and section_bundle: "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
  shows "(\<not>(R overlaps s))"
proof (insert not_overlaps, rule contrapos_nn, assumption)
  assume all_overlaps: "R overlaps s"
  then have "s \<le>\<^sub>b s1"
    using hull isHull_def section_bundle by blast
  then show "R overlaps s1"
    using not_overlaps all_overlaps T1 by blast
qed

definition overlapsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool"  where
"overlapsAsMuchAs R b R' == (\<forall>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> R' overlaps s \<longrightarrow> R overlaps s)"

notation
  overlapsAsMuchAs ("_ \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>_ _" [80, 80, 80] 80)

definition eq_overlapsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool"  where
"eq_overlapsAsMuchAs R b R' == R \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R' \<and> R' \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R"

notation
  eq_overlapsAsMuchAs ("_ \<cong>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>_ _" [80, 80, 80] 80)

abbreviation
rev_overlapsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool"  ("_ \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>_ _" [80, 80, 80] 80)
where"rev_overlapsAsMuchAs R b R' == overlapsAsMuchAs R' b R"

definition more_overlapsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool"  where
"more_overlapsAsMuchAs R b R' == R \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R' \<and> \<not>(R' \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R)"

notation
  more_overlapsAsMuchAs ("_ >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>_ _" [80, 80, 80] 80)

abbreviation
less_overlapsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool"  ("_ <\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>_ _" [80, 80, 80] 80)
where"less_overlapsAsMuchAs R b R' == more_overlapsAsMuchAs R' b R"

(*Formalise and prove that overlapsAsMuchAs is reflexive and transitive*) (*2 marks*)

lemma overlapsAsMuchAs_reflexive:
(*Write your formalisation and proof that overlapsAsMuchAs is reflexive here*)
  assumes "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" shows "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1"
  by (simp add: overlapsAsMuchAs_def)

lemma overlapsAsMuchAs_transitive:
(*Write your formalisation and proof that overlapsAsMuchAs is transitive here*)
  assumes "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" shows "(R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2 \<and> R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R3) \<longrightarrow> (R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R3)"
  by (simp add: overlapsAsMuchAs_def)

(*Write your formalisation and structured proof of Theorem T3 here. You must attempt to
formalise Kulik et al.'s reasoning*) (*11 marks*)
lemma T3: "\<forall>b R1 R2. (R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<longleftrightarrow> (\<exists>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> R1 overlaps s \<and> \<not>(R2 overlaps s))"
proof ((rule allI)+, rule iffI)
  fix b R1 R2
(*Left-to-right \<Rightarrow>*)
  assume moreThan: "R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
  then have asMuchAs: "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    by (simp add: more_overlapsAsMuchAs_def)
  then have not_asMuchAs: "\<not>(R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1)"
    using more_overlapsAsMuchAs_def moreThan by blast
(*overlaps as much as definition*)
  obtain s where ov_def: "s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> R2 overlaps s \<longrightarrow> R1 overlaps s"
                and not_ov_def: "\<not>(s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> R1 overlaps s \<longrightarrow> R2 overlaps s)"
    using not_asMuchAs overlapsAsMuchAs_def by blast
  then have overlaps: "R1 overlaps s"
    by blast
  then have not_overlaps: "\<not>(R2 overlaps s)"
    using not_ov_def by blast
  then have "(\<not>(s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b) \<or> R1 overlaps s) \<and> \<not>(R2 overlaps s)" (*Equivalent to not_ov_def*)
    using not_ov_def by blast
  then show "\<exists>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> R1 overlaps s \<and> \<not>(R2 overlaps s)"
    using not_ov_def by blast
next
(*Right-to-left \<Leftarrow>*)
  fix b R1 R2
  assume "(\<exists>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> R1 overlaps s \<and> \<not>(R2 overlaps s))"
  then obtain s1 where section_bundle1: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" and overlaps1: "R1 overlaps s1"
                       and not_overlaps1: "\<not>(R2 overlaps s1)"
    by blast
  then obtain s2 where section_bundle2: "s2 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    by blast
  then have "(s1 \<le>\<^sub>b s2 \<or> s2 \<le>\<^sub>b s1)"
    using SB2 section_bundle1 by auto
  then have restrictive: "s1 \<le>\<^sub>b s2 \<or> s2 \<le>\<^sub>b s1"
    using section_bundle1 section_bundle2 by blast
 (* then have part_of: "(s1 isPartOf s2) \<or> (s2 isPartOf s1)"
    using atLeastAsRestrictiveAs_def by blast*)
  (*Proof by cases*)
  from restrictive consider "s1 \<le>\<^sub>b s2" | "s2 \<le>\<^sub>b s1" by auto
  then have asMuchAs: "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
  proof (cases)
    assume res1: "s1 \<le>\<^sub>b s2"
    then have "(R1 overlaps s1) \<longrightarrow> (s1 \<le>\<^sub>b s2) \<longrightarrow> (R1 overlaps s2)"
      using T1 by blast
    then have overlaps2: "R1 overlaps s2"
      using overlaps1 res1 by blast
    then show "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
      using SB2 T1 not_overlaps1 overlaps1 overlapsAsMuchAs_def section_bundle1 by blast
  next
    assume res2: "s2 \<le>\<^sub>b s1"
    then have expanded_t1: "(\<not>(R2 overlaps s1) \<or> (s2 \<le>\<^sub>b s1)) \<and> \<not>(R2 overlaps s2)"
      using T1 not_overlaps1 by blast
    then have not_overlaps2: "\<not>(R2 overlaps s2)"
      by blast
    then show "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
      using SB2 T1 not_overlaps1 overlaps1 overlapsAsMuchAs_def section_bundle1 by blast
  qed
  have not_asMuchAs: "\<not>(R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1)"
    using section_bundle1 overlaps1 not_overlaps1 overlapsAsMuchAs_def by blast
  then have "R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    by (simp add: asMuchAs more_overlapsAsMuchAs_def not_asMuchAs)
  then show "R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    by blast
qed

(*In under 200 words, compare and contrast the mechanical proof that you produced with the
pen-and-paper proof by Kulik et al.\. In particular, indicate any reasoning, proof parts, and/or
useful lemmas that you had to make explicit during the mechanisation but may have been glossed over
 or assumed by the pen-and-paper proof. Also highlight any inaccuracies in their language or
notation. Note any parts where you had to diverge from their reasoning, and why.
Write your answer in a comment here.*) (*4 marks*)

(*
LEFT-TO-RIGHT \<Rightarrow>
In my paper proof, I just assumed I had an 's' and didn't consider having to get a specific 's' for
the \<exists>s in the conclusion. So, my paper proof was very simple, where I expanded R1 > R2 by the
definition of more_overlapsAsMuchAs in order to obtain R1 \<ge> R2 and \<not>(R2 \<ge> R1). Then, I expanded
both of these expressions using the definition of overlapsAsMuchAs to get 'R1 overlaps s' and
'\<not>(R2 overlaps s)' respectively, both of which are in the conclusion.
However, for my Isabelle proof, I had to explicitly obtain section 's' using the constraints imposed
by the definition of overlapsAsMuchAs in order to prove the conclusion. I had to make explicit the
the definition of overlapsAsMuchAS to get 'R1 overlaps s' and '\<not>(R2 overlaps s)'.

RIGHT-TO-LEFT \<Leftarrow>
For this proof I followed Kulik et al.'s reasoning. One of the incaccuracies is that they mentioned
getting 's1 isPartOf s2 \<or> s2 isPartOf s1' using SB2, but these expressions didn't help me in the
proof. Instead, I used atLeastAsRestrictiveAs in order to obtain the regions overlapping the sections
using T1. That is, I had to do a proof by cases using 's1 \<le>\<^sub>b s2' and 's2 \<le>\<^sub>b s1' separately.
For proving 'R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2', I had to explicitly indicate that I was using lemma T1 and
axiom SB2, not only T1 as stated by Kulik. In my mechanical proof, I also had to make explicit that
I had '\<not>(R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1)' from '\<not>(R2 overlaps s)' to obtain the conclusion.
*)

(*Write your formalisation and proof of Theorem T4 here*) (*1 mark*)
lemma T4: "\<forall>b R1 R2. (R1  >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<cong>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 <\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
  using T3 eq_overlapsAsMuchAs_def overlapsAsMuchAs_def by auto

(*Write your formalisation and structured proof of Theorem T5 here.
You must show it follows from T4*) (*3 marks*)
lemma T5: "\<forall>b R1 R2. (R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
proof ((rule allI)+)
  fix b R1 R2
  have "(R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<cong>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 <\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
    by (simp add: T4)
  from this consider "(R1  >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)" | "(R1 \<cong>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)" | "(R1 <\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)" by auto
  then have concl: "(R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
  proof (cases)
    assume "R1 >\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    then have "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2 \<and> \<not>(R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1)"
      using more_overlapsAsMuchAs_def by blast
    then have "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
      by simp
    then show "(R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
      by simp
  next
    assume "R1 \<cong>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    then have "R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2 \<and> R2 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1"
      using eq_overlapsAsMuchAs_def by blast
    then show "(R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
      by blast
  next
    assume "R1 <\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    then have "R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2 \<and> \<not>(R2 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1)"
      using more_overlapsAsMuchAs_def by blast
    then show "(R1 \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2) \<or> (R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2)"
      by blast
  qed
  then show "R2 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1 \<or> R1 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R2"
    by simp
qed

(********************Challenge problem****************************************)

(*Write your definition of the relation ci here.
Kulik et al. say `If a region crosses or is included in a section we write ci'.*) (*2 marks*)
definition crosses_isIncludedIn :: "'region \<Rightarrow> 'section \<Rightarrow> bool"  where
"crosses_isIncludedIn R s \<equiv> R crosses s \<or> R isIncludedIn s"

notation
  crosses_isIncludedIn ("_ ci _" 80)

(*Write your definition of `crosses or is included in as much as' here*) (*2 marks*)
definition crosses_isIncludedInAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool" where
"crosses_isIncludedInAsMuchAs R b R' \<equiv> (\<forall>s. s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> (R crosses s \<or> (R' isIncludedIn s \<longrightarrow> R isIncludedIn s)))"

notation
  crosses_isIncludedInAsMuchAs ("_ \<ge>\<^sub>c\<^sub>i \<^sub>_ _" [80, 80, 80] 80)

(*Write your definition of `belongs as much as here: definition D8 in the paper.*) (*2 marks*)
definition belongsAsMuchAs :: "'region \<Rightarrow> 'bundle \<Rightarrow> 'region \<Rightarrow> bool" where
"belongsAsMuchAs R b R' \<equiv>  (R \<ge>\<^sub>c\<^sub>i \<^sub>b R') \<and> (R \<ge>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R')"

notation
  belongsAsMuchAs ("_ \<ge> \<^sub>_ _" [80, 80, 80] 80)

(*Formalise and write structured proofs of Theorems T6-T8 for both crossesIncludedInAsMuchAs and
belongsAsMuchAs*) (*14 marks*)

lemma T6_crosses_isIncludedInAsMuchAs: "\<forall>b R1. (\<exists>s. s isHull b \<and> \<not>(R1 overlaps s)) \<longrightarrow> (\<forall>R2. R2 \<ge>\<^sub>c\<^sub>i \<^sub>b R1)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  assume "\<exists>s. s isHull b \<and> \<not>(R1 overlaps s)"
  then obtain s1 where hull: "s1 isHull b" and not_overlaps: "\<not>(R1 overlaps s1)"
    by blast
  then have hull_def: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<and> (\<forall>s2. s2 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<longrightarrow> s2 \<le>\<^sub>b s1)"
    using hull isHull_def by blast
  then have section_bundle: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    by blast
  then show "R2 \<ge>\<^sub>c\<^sub>i \<^sub>b R1"
    by (meson crosses_isIncludedInAsMuchAs_def hull inclusion_def isPartOf_def not_overlap_hull
        not_overlaps overlaps_def region_overlaps_itself)
qed
(*
  assume "s2 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
  then have res: "s2 \<le>\<^sub>b s1"
    using hull_def by blast
  then have "s2 isPartOf s1"
    by (simp add: atLeastAsRestrictiveAs_def)
  then have part: "(region_to_section R2) isPartOf s1" (*s2 = region_to_section R2*)
    by (simp add: eq)
  then have inclusion1: "R2 isIncludedIn s1"
    by (simp add: inclusion_def)
  then have not_crosses: "\<not>(R1 crosses s1)" (*\<^sub>c\<^sub>iconclusion of \<ge>\<^sub>c\<^sub>i: R1 crosses s1 \<or> (R2 isIncludedIn s1 \<longrightarrow> R1 isIncludedIn s1)*)
    using SC1 not_overlaps by blast
*)

(*
We can show "R2 \<ge>\<^sub>c\<^sub>i \<^sub>b R1" by its definition.
Since we have obtained "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b" from isHull_def, we can get
"R1 crosses s1 \<or> (R2 isIncludedIn s1 \<longrightarrow> R1 isIncludedIn s1)".
But we have the assumption that "\<not>(R1 overlaps s1)", so we have that "\<not>(R1 crosses s1)" by
the definition of overlaps.
Thus, we know that in the disjunction above, it must be the case that "(R2 isIncludedIn s1 \<longrightarrow> R1 isIncludedIn s1)".
We have that "R2 isIncludedIn s1" if we assume that "region_to_section R2" gives us s2.
We obtained that "s2 isPartOF s1" from the atLeastAsRestrictiveAs_def "s2 \<le>\<^sub>b s1" (obtained from hull definition)
Therefore, from the intermediate proofs above, we can show that "R2 \<ge>\<^sub>c\<^sub>i \<^sub>b R1"
*)

lemma T6_belongsAsMuchAs: "\<forall>b R1. (\<exists>s. s isHull b \<and> \<not>(R1 overlaps s)) \<longrightarrow> (\<forall>R2. R2 \<ge> \<^sub>b R1)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  assume "\<exists>s. s isHull b \<and> \<not>(R1 overlaps s)"
  then obtain s1 where hull: "s1 isHull b" and not_overlaps: "\<not>(R1 overlaps s1)"
    by blast
  then have section_bundle: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    using isHull_def by blast
  then show "R2 \<ge> \<^sub>b R1"
  proof -
    have overlaps: "\<forall>R3 b R4. \<exists>s. (R3 overlaps s \<or> R3 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R4) \<and> (s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<or> R3 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R4)"
      using overlapsAsMuchAs_def by blast
    then show "R2 \<ge> \<^sub>b R1"
      by (meson T1 T6_crosses_isIncludedInAsMuchAs belongsAsMuchAs_def hull isHull_def not_overlaps)
  qed
qed

lemma T7_crosses_isIncludedInAsMuchAs: "\<forall>b R1. (\<exists>s. s isCoreOf b \<and> R1 isIncludedIn s) \<longrightarrow> (\<forall>R2. R1 \<ge>\<^sub>c\<^sub>i \<^sub>b R2)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  fix s2
  assume "\<exists>s. s isCoreOf b \<and> R1 isIncludedIn s"
  then obtain s1 where core: "s1 isCoreOf b" and inclusion1: "R1 isIncludedIn s1"
    by blast
  then have section_bundle1: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    by (simp add: isCore_def)
  then show "R1 \<ge>\<^sub>c\<^sub>i \<^sub>b R2"
    using T2 core crosses_isIncludedInAsMuchAs_def inclusion1 isCore_def by blast
qed

lemma T7_belongsAsMuchAs: "\<forall>b R1. (\<exists>s. s isCoreOf b \<and> R1 isIncludedIn s) \<longrightarrow> (\<forall>R2. R1 \<ge> \<^sub>b R2)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  assume "\<exists>s. s isCoreOf b \<and> R1 isIncludedIn s"
  then obtain s1 where core: "s1 isCoreOf b" and inclusion1: "R1 isIncludedIn s1"
    by blast
  then have section_bundle1: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    by (simp add: isCore_def)
  then show "R1 \<ge> \<^sub>b R2"
  proof -
    have "\<forall>s. R1 overlaps s \<or> \<not> s1 isPartOf s"
      by (meson inclusion1 inclusion_def isPartOf_def overlaps_def section_nonempty)
    then show "R1 \<ge> \<^sub>b R2"
      using T7_crosses_isIncludedInAsMuchAs atLeastAsRestrictiveAs_def belongsAsMuchAs_def core
            inclusion1 isCore_def overlapsAsMuchAs_def by auto
  qed
qed

lemma T8_crosses_isIncludedInAsMuchAs: "\<forall>b R1. (\<exists>s. s isHull b \<and> (R1 crosses s)) \<longrightarrow> (\<forall>R2. R1 \<ge>\<^sub>c\<^sub>i \<^sub>b R2)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  assume "\<exists>s. s isHull b \<and> (R1 crosses s)"
  then obtain s1 where hull: "s1 isHull b" and cross: "R1 crosses s1"
    by blast
  then have section_bundle1: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    using isHull_def by blast
  then show "R1 \<ge>\<^sub>c\<^sub>i \<^sub>b R2"
    using cross crosses_hull crosses_isIncludedInAsMuchAs_def hull by blast
qed

lemma T8_belongsAsMuchAs: "\<forall>b R1. (\<exists>s. s isHull b \<and> (R1 crosses s)) \<longrightarrow> (\<forall>R2. R1 \<ge> \<^sub>b R2)"
proof ((rule allI)+, rule impI, rule allI)
  fix b R1 R2
  assume "\<exists>s. s isHull b \<and> (R1 crosses s)"
  then obtain s1 where hull: "s1 isHull b" and cross: "R1 crosses s1"
    by blast
  then have section_bundle1: "s1 \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b"
    using isHull_def by blast
  then show "R1 \<ge> \<^sub>b R2"
  proof -
    have "\<forall>s. \<not> s \<iota>\<^sub>s\<^sub>e\<^sub>c\<^sub>t\<^sub>i\<^sub>o\<^sub>n b \<or> R1 crosses s"
      using cross crosses_hull hull by blast
    then have overlaps1: "R2 \<le>\<^sub>o\<^sub>v\<^sub>e\<^sub>r\<^sub>l\<^sub>a\<^sub>p\<^sub>s \<^sub>b R1"
      by (simp add: SC1 overlapsAsMuchAs_def)
    then show "R1 \<ge> \<^sub>b R2"
      using T8_crosses_isIncludedInAsMuchAs belongsAsMuchAs_def cross hull by blast
  qed
qed

end

end