theory connectedness
  imports separation
begin

(**The sets A and B constitute a separation of a set S.*)
definition Separation ("Separation[_]")
  where "Separation[\<C>] S A B \<equiv> nonEmpty A \<and> nonEmpty B \<and> Sep[\<C>] A B \<and> S \<approx> A \<^bold>\<or> B"

(**A set is called separated if it has a separation.*)
definition Separated ("Separated[_]")
  where "Separated[\<C>] S \<equiv> \<exists>A B. Separation[\<C>] S A B"

(**A set is called connected if it has no separation.*)
abbreviation Connected ("Connected[_]")
  where "Connected[\<C>] S \<equiv> \<not>Separated[\<C>] S"

(**Empty sets and singletons are connected.*)
lemma conn_prop1: "Connected[\<C>] \<^bold>\<bottom>" by (smt (verit, best) L10 L6 Separated_def Separation_def bottom_def setequ_equ subset_def)
lemma conn_prop2: "Cl_2 \<C> \<Longrightarrow> \<forall>x. Connected[\<C>] {x}" by (smt (verit, best) singleton_def Disj_def Sep_disj Separated_def Separation_def bottom_def join_def meet_def setequ_equ)

(**A connected subset of a separated set X = (A|B) is contained in either A or B. *)
lemma conn_prop3: assumes mono: "MONO \<C>"
              shows "\<forall>S X. Connected[\<C>] S \<and> S \<preceq> X \<longrightarrow> (\<forall>A B. Separation[\<C>] X A B \<longrightarrow> (S \<preceq> A \<or> S \<preceq> B))"
proof -
  { fix S X { assume conn: "Connected[\<C>] S" and subset: "S \<preceq> X"
    { fix A B { assume sep: "Separation[\<C>] X A B"
      from subset sep have aux: "S \<approx> (S \<^bold>\<and> A) \<^bold>\<or> (S \<^bold>\<and> B)" by (smt (verit, best) BA_distr1 L10 Separation_def meet_def setequ_char)
      from this mono sep conn have "Disj S A \<or> Disj S B" unfolding Separated_def by (smt (verit, best) Disj_char L3 L5 Sep_sub Separation_def bottom_def setequ_char)
        hence "(S \<preceq> A \<or> S \<preceq> B)" by (smt (verit) Disj_def L14 L5 aux join_def setequ_equ subset_def)
  }}}} thus ?thesis by blast
qed

(**If S is connected and @{text "S \<preceq> X \<preceq> \<C>(S)"} then X is connected too.*)
lemma conn_prop4: assumes mono: "MONO \<C>"
                  shows "\<forall>S X. Connected[\<C>] S \<and> S \<preceq> X \<and> X \<preceq> \<C> S \<longrightarrow> Connected[\<C>] X"
proof -
  { fix S X { assume conn: "Connected[\<C>] S" and SsubsetX: "S \<preceq> X" and XsubsetCS: "X \<preceq> \<C> S"
    from mono conn SsubsetX have aux: "(\<forall>A B. Separation[\<C>] X A B \<longrightarrow> (S \<preceq> A \<or> S \<preceq> B))"
      using conn_prop3 by blast
    have "Connected[\<C>] X" proof
      assume "Separated[\<C>] X"
      from this obtain A and B where sepXAB: "Separation[\<C>] X A B" using Separated_def by blast
      from this aux have "(S \<preceq> A \<or> S \<preceq> B)" by blast
      thus "False" proof
        assume assm: "S \<preceq> A"
        from this mono have "\<C> S \<preceq> \<C> A" by (simp add: MONO_def)
        from this assm sepXAB have 1: "Disj (\<C> S) B" by (metis (mono_tags) Sep_def Sep_sub Separation_def mono subset_def)
        from sepXAB XsubsetCS have 2: "B \<preceq> \<C> S" by (simp add: Separation_def join_def setequ_equ subset_def)
        from sepXAB have 3: "nonEmpty B" by (simp add: Separation_def)
        from 1 2 3 show "False" by (metis Disj_char L10 bottom_def setequ_equ)
      next
        assume assm: "S \<preceq> B" (*same reasoning as previous case*)
        from this mono have "\<C> S \<preceq> \<C> B" by (simp add: MONO_def)
        from this assm sepXAB have 1: "Disj (\<C> S) A" by (metis (mono_tags) Sep_def Sep_sub Separation_def mono subset_def)
        from sepXAB XsubsetCS have 2: "A \<preceq> \<C> S" by (simp add: Separation_def join_def setequ_equ subset_def)
        from sepXAB have 3: "nonEmpty A" by (simp add: Separation_def)
        from 1 2 3 show "False" by (metis Disj_char L10 bottom_def setequ_equ)
      qed
    qed
  }} thus ?thesis by blast
qed

(**If every two points of a set X are contained in some connected subset of X then X is connected.*)
lemma conn_prop5: assumes mono: \<open>MONO \<C>\<close> and cl2: \<open>Cl_2 \<C>\<close> shows
 \<open>(\<forall>p q. X p \<and> X q \<and> (\<exists>S. S \<preceq> X \<and> Connected[\<C>] S \<and> S p \<and> S q)) \<longrightarrow> Connected[\<C>] X\<close>
proof -
{ assume premise: \<open>\<forall>p q. X p \<and> X q \<and> (\<exists>S. S \<preceq> X \<and> Connected[\<C>] S \<and> S p \<and> S q)\<close>
  have \<open>Connected[\<C>] X\<close> proof
    assume \<open>Separated[\<C>] X\<close>
    then obtain A and B where sepXAB: \<open>Separation[\<C>] X A B\<close>
      using Separated_def by blast
    hence nonempty: \<open>nonEmpty A \<and> nonEmpty B\<close>
      by (simp add: Separation_def)
    let ?p = \<open>SOME a. A a\<close> and ?q = \<open>SOME b. B b\<close> (*since A and B are non-empty*)
    from nonempty have \<open>X ?p \<and> X ?q\<close>
      by (simp add: premise)
    hence \<open>\<exists>S. S \<preceq> X \<and> Connected[\<C>] S \<and> S ?p \<and> S ?q\<close>
      by (simp add: premise)
    then obtain S where aux: \<open>S \<preceq> X \<and> Connected[\<C>] S \<and> S ?p \<and> S ?q\<close> ..
    from aux nonempty have \<open>\<not>Disj S A \<and> \<not>Disj S B\<close>
      by (metis Disj_def someI)
    moreover from aux mono sepXAB have \<open>S \<preceq> A \<or> S \<preceq> B\<close>
      using conn_prop3 by blast
    moreover from cl2 sepXAB have \<open>Disj A B\<close>
      by (simp add: Sep_disj Separation_def)
    ultimately show False
      by (metis (mono_tags, lifting) Disj_def subset_def)
  qed
} thus ?thesis ..
qed

end


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

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

datatype Nat = Z | S "Nat"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S z) y = S (plus z y)"

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

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
"deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

fun deleteAll :: "'a => 'a list => 'a list" where
"deleteAll x (nil2) = nil2"
| "deleteAll x (cons2 z ys) =
     (if (x = z) then deleteAll x ys else cons2 z (deleteAll x ys))"

fun count :: "'a => 'a list => Nat" where
"count x (nil2) = Z"
| "count x (cons2 z ys) =
     (if (x = z) then plus (S Z) (count x ys) else count x ys)"

theorem property0 :
  "(((deleteAll x xs) =
       (deleteBy (% (y :: 'a) => % (z :: 'a) => (y = z)) x xs)) ==>
      (le (count x xs) (S Z)))"
  oops

end


(*  Title:      HOL/HOLCF/Fun_Cpo.thy
    Author:     Franz Regensburger
    Author:     Brian Huffman
*)

section \<open>Class instances for the full function space\<close>

theory Fun_Cpo
  imports Adm
begin

subsection \<open>Full function space is a partial order\<close>

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

definition below_fun_def: "(\<sqsubseteq>) \<equiv> (\<lambda>f g. \<forall>x. f x \<sqsubseteq> g x)"

instance ..
end

instance "fun" :: (type, po) po
proof
  fix f :: "'a \<Rightarrow> 'b"
  show "f \<sqsubseteq> f"
    by (simp add: below_fun_def)
next
  fix f g :: "'a \<Rightarrow> 'b"
  assume "f \<sqsubseteq> g" and "g \<sqsubseteq> f" then show "f = g"
    by (simp add: below_fun_def fun_eq_iff below_antisym)
next
  fix f g h :: "'a \<Rightarrow> 'b"
  assume "f \<sqsubseteq> g" and "g \<sqsubseteq> h" then show "f \<sqsubseteq> h"
    unfolding below_fun_def by (fast elim: below_trans)
qed

lemma fun_below_iff: "f \<sqsubseteq> g \<longleftrightarrow> (\<forall>x. f x \<sqsubseteq> g x)"
  by (simp add: below_fun_def)

lemma fun_belowI: "(\<And>x. f x \<sqsubseteq> g x) \<Longrightarrow> f \<sqsubseteq> g"
  by (simp add: below_fun_def)

lemma fun_belowD: "f \<sqsubseteq> g \<Longrightarrow> f x \<sqsubseteq> g x"
  by (simp add: below_fun_def)

subsection \<open>Full function space is chain complete\<close>

text \<open>Properties of chains of functions.\<close>

lemma fun_chain_iff: "chain S \<longleftrightarrow> (\<forall>x. chain (\<lambda>i. S i x))"
  by (auto simp: chain_def fun_below_iff)

lemma ch2ch_fun: "chain S \<Longrightarrow> chain (\<lambda>i. S i x)"
  by (simp add: chain_def below_fun_def)

lemma ch2ch_lambda: "(\<And>x. chain (\<lambda>i. S i x)) \<Longrightarrow> chain S"
  by (simp add: chain_def below_fun_def)

text \<open>Type \<^typ>\<open>'a::type \<Rightarrow> 'b::cpo\<close> is chain complete\<close>

lemma is_lub_lambda: "(\<And>x. range (\<lambda>i. Y i x) <<| f x) \<Longrightarrow> range Y <<| f"
  by (simp add: is_lub_def is_ub_def below_fun_def)

lemma is_lub_fun: "chain S \<Longrightarrow> range S <<| (\<lambda>x. \<Squnion>i. S i x)"
  for S :: "nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo"
  apply (rule is_lub_lambda)
  apply (rule cpo_lubI)
  apply (erule ch2ch_fun)
  done

lemma lub_fun: "chain S \<Longrightarrow> (\<Squnion>i. S i) = (\<lambda>x. \<Squnion>i. S i x)"
  for S :: "nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo"
  by (rule is_lub_fun [THEN lub_eqI])

instance "fun"  :: (type, cpo) cpo
  by intro_classes (rule exI, erule is_lub_fun)

instance "fun" :: (type, discrete_cpo) discrete_cpo
proof
  fix f g :: "'a \<Rightarrow> 'b"
  show "f \<sqsubseteq> g \<longleftrightarrow> f = g"
    by (simp add: fun_below_iff fun_eq_iff)
qed

subsection \<open>Full function space is pointed\<close>

lemma minimal_fun: "(\<lambda>x. \<bottom>) \<sqsubseteq> f"
  by (simp add: below_fun_def)

instance "fun"  :: (type, pcpo) pcpo
  by standard (fast intro: minimal_fun)

lemma inst_fun_pcpo: "\<bottom> = (\<lambda>x. \<bottom>)"
  by (rule minimal_fun [THEN bottomI, symmetric])

lemma app_strict [simp]: "\<bottom> x = \<bottom>"
  by (simp add: inst_fun_pcpo)

lemma lambda_strict: "(\<lambda>x. \<bottom>) = \<bottom>"
  by (rule bottomI, rule minimal_fun)

subsection \<open>Propagation of monotonicity and continuity\<close>

text \<open>The lub of a chain of monotone functions is monotone.\<close>

lemma adm_monofun: "adm monofun"
  by (rule admI) (simp add: lub_fun fun_chain_iff monofun_def lub_mono)

text \<open>The lub of a chain of continuous functions is continuous.\<close>

lemma adm_cont: "adm cont"
  by (rule admI) (simp add: lub_fun fun_chain_iff)

text \<open>Function application preserves monotonicity and continuity.\<close>

lemma mono2mono_fun: "monofun f \<Longrightarrow> monofun (\<lambda>x. f x y)"
  by (simp add: monofun_def fun_below_iff)

lemma cont2cont_fun: "cont f \<Longrightarrow> cont (\<lambda>x. f x y)"
  apply (rule contI2)
   apply (erule cont2mono [THEN mono2mono_fun])
  apply (simp add: cont2contlubE lub_fun ch2ch_cont)
  done

lemma cont_fun: "cont (\<lambda>f. f x)"
  using cont_id by (rule cont2cont_fun)

text \<open>
  Lambda abstraction preserves monotonicity and continuity.
  (Note \<open>(\<lambda>x. \<lambda>y. f x y) = f\<close>.)
\<close>

lemma mono2mono_lambda: "(\<And>y. monofun (\<lambda>x. f x y)) \<Longrightarrow> monofun f"
  by (simp add: monofun_def fun_below_iff)

lemma cont2cont_lambda [simp]:
  assumes f: "\<And>y. cont (\<lambda>x. f x y)"
  shows "cont f"
  by (rule contI, rule is_lub_lambda, rule contE [OF f])

text \<open>What D.A.Schmidt calls continuity of abstraction; never used here\<close>

lemma contlub_lambda: "(\<And>x. chain (\<lambda>i. S i x)) \<Longrightarrow> (\<lambda>x. \<Squnion>i. S i x) = (\<Squnion>i. (\<lambda>x. S i x))"
  for S :: "nat \<Rightarrow> 'a::type \<Rightarrow> 'b::cpo"
  by (simp add: lub_fun ch2ch_lambda)

end


theory Week4
  imports Main
begin

lemma modus_tollens:
  assumes "A \<longrightarrow> B"
  assumes "\<not> B"
  shows "\<not> A"
proof(rule notI)
  assume A
  with `A \<longrightarrow> B` have B by (rule mp) (* works with two dots `..` as well*)
  with `\<not>B` show False by (rule notE)
qed

lemma
  assumes major_premise: "A \<longrightarrow> B\<longrightarrow> C"
  assumes minor_premise: A
  shows conclusion: "B \<longrightarrow> C"
proof
  assume B
  from major_premise have "B \<longrightarrow> C" using minor_premise by (rule mp)
(* difference between from and with ?? *)
  then show C using `B` by (rule mp)
qed

lemma
  assumes major_premise: "A \<longrightarrow> B \<longrightarrow> C"
  assumes wide_scope: "\<not>(B \<longrightarrow> C)"
  shows notA: "\<not>A"
proof
  assume A
  with Week4.modus_tollens show False by blast  (*? ?*)
qed

lemma
  assumes major_premise: "A \<longrightarrow> B\<longrightarrow> C"
  assumes narrow_scope: "B \<longrightarrow> \<not>C"
  shows notA: "\<not>A"
  oops

lemma conditional_noncontradiction: "\<not> ((A \<longrightarrow> B) \<and> (A \<longrightarrow> \<not> B))" oops

(* IMPORTATNT *)
lemma conditional_excluded_middle: "(A \<longrightarrow> B) \<or> (A \<longrightarrow> \<not> B)"
proof cases
  assume B
  hence "A \<longrightarrow> B"..
  thus "(A \<longrightarrow> B) \<or> (A \<longrightarrow> \<not> B)"..
      next
        assume "\<not>B"
        then have "A \<longrightarrow> \<not> B"..
        then show "(A \<longrightarrow> B) \<or> (A \<longrightarrow> \<not> B)"..
      qed

lemma  "(A \<longrightarrow> B) \<or> (B \<longrightarrow>  A)" oops (* ToDo*)

(* Disjunction Introduction *)

lemma "A \<longrightarrow> (A \<or> B)"
proof (rule impI)
  assume A
  show "A \<or> B"
  proof (rule disjI1)
    from `A` show A.
    qed
  qed

lemma "B \<longrightarrow> (A \<or> B)"
proof (rule impI)
  assume B
  thus "A \<or> B" by (rule disjI2)
qed

lemma "(A \<longrightarrow> B) \<longrightarrow> (A \<longrightarrow> B \<or> C)"
proof (rule impI)
  assume "A \<longrightarrow> B"
  show "A \<longrightarrow> B \<or> C"
  proof (rule impI)
    assume A
    show "B \<or> C"
    proof (rule disjI1)
      from `A \<longrightarrow> B` show B using `A` by (rule mp)
    qed
  qed
qed

(* Disjunction Elimination *)
lemma "A \<or> A \<longrightarrow> A"
proof
assume "A \<or> A"
  thus A
  proof (rule disjE)
    assume A
    thus A.
        next
          assume A
          thus A.
              qed
            qed

(* IMPORTANT *)
lemma "A \<or> B \<and> C \<longrightarrow> (A \<or> B) \<and> (A \<or> C)" (* precedence given to conj *)
proof (rule impI)
  assume "A \<or> B \<and> C"
  then show "(A \<or> B) \<and> (A \<or> C)"
  proof (rule disjE)
    assume A
    then have "A \<or> B" by (rule disjI1)
    moreover from `A` have "A \<or> C" by (rule disjI1)
    ultimately show "(A \<or> B) \<and> (A \<or> C)" by (rule conjI)
  next
    assume "B \<and> C"
    then have B by (rule conjunct1) (* or conjE *)
    then have "A \<or> B" by (rule disjI2)
    then show "(A \<or> B) \<and> (A \<or> C)"
    proof (rule conjI)
      from `B \<and> C` have C by (rule conjE)
      thus "A \<or> C" by (rule disjI2)
    qed
  qed
qed

(* Proof by Cases *)

lemma excluded_middle: "A \<or> \<not> A"
proof cases
  assume A
  then show "A \<or> \<not>A" ..
  next
    assume "\<not>A"
    then show "A \<or> \<not>A"..
  qed

lemma excluded_middle2: "A \<or> \<not> A"
proof(rule ccontr)
  assume "\<not>(A \<or> \<not> A)"
  have "\<not>A" (* consequeces of using then ?*)
    proof
      assume A
      then have "A \<or> \<not> A" by (rule disjI1)
      with `\<not>(A \<or> \<not> A)` show False by (rule notE)
          qed
          hence "A \<or> \<not> A" by (rule disjI2)
          with `\<not> (A \<or> \<not> A)` show False by (rule notE)
        qed

end


section {* Various examples for transfer procedure *}

theory Transfer_Ex
imports Main Transfer_Int_Nat
begin

lemma ex1: "(x::nat) + y = y + x"
  by auto

lemma "0 \<le> (y\<Colon>int) \<Longrightarrow> 0 \<le> (x\<Colon>int) \<Longrightarrow> x + y = y + x"
  by (fact ex1 [transferred])

(* Using new transfer package *)
lemma "0 \<le> (x\<Colon>int) \<Longrightarrow> 0 \<le> (y\<Colon>int) \<Longrightarrow> x + y = y + x"
  by (fact ex1 [untransferred])

lemma ex2: "(a::nat) div b * b + a mod b = a"
  by (rule mod_div_equality)

lemma "0 \<le> (b\<Colon>int) \<Longrightarrow> 0 \<le> (a\<Colon>int) \<Longrightarrow> a div b * b + a mod b = a"
  by (fact ex2 [transferred])

(* Using new transfer package *)
lemma "0 \<le> (a\<Colon>int) \<Longrightarrow> 0 \<le> (b\<Colon>int) \<Longrightarrow> a div b * b + a mod b = a"
  by (fact ex2 [untransferred])

lemma ex3: "ALL (x::nat). ALL y. EX z. z >= x + y"
  by auto

lemma "\<forall>x\<ge>0\<Colon>int. \<forall>y\<ge>0. \<exists>z\<ge>0. x + y \<le> z"
  by (fact ex3 [transferred nat_int])

(* Using new transfer package *)
lemma "\<forall>x\<Colon>int\<in>{0..}. \<forall>y\<in>{0..}. \<exists>z\<in>{0..}. x + y \<le> z"
  by (fact ex3 [untransferred])

lemma ex4: "(x::nat) >= y \<Longrightarrow> (x - y) + y = x"
  by auto

lemma "0 \<le> (x\<Colon>int) \<Longrightarrow> 0 \<le> (y\<Colon>int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
  by (fact ex4 [transferred])

(* Using new transfer package *)
lemma "0 \<le> (y\<Colon>int) \<Longrightarrow> 0 \<le> (x\<Colon>int) \<Longrightarrow> y \<le> x \<Longrightarrow> tsub x y + y = x"
  by (fact ex4 [untransferred])

lemma ex5: "(2::nat) * \<Sum>{..n} = n * (n + 1)"
  by (induct n rule: nat_induct, auto)

lemma "0 \<le> (n\<Colon>int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
  by (fact ex5 [transferred])

(* Using new transfer package *)
lemma "0 \<le> (n\<Colon>int) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
  by (fact ex5 [untransferred])

lemma "0 \<le> (n\<Colon>nat) \<Longrightarrow> 2 * \<Sum>{0..n} = n * (n + 1)"
  by (fact ex5 [transferred, transferred])

(* Using new transfer package *)
lemma "0 \<le> (n\<Colon>nat) \<Longrightarrow> 2 * \<Sum>{..n} = n * (n + 1)"
  by (fact ex5 [untransferred, Transfer.transferred])

end


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

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

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

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

fun elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
"deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

fun isPermutation :: "'a list => 'a list => bool" where
"isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z x2) = False"
| "isPermutation (cons2 x3 xs) y =
     ((elem x3 y) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 y)))"

theorem property0 :
  "isPermutation (isort xs) xs"
  oops

end


theory Point_Set_Topology
  imports Main
begin

sledgehammer_params [smt_proofs = false]

named_theorems point_set_continuous_intros "structural introduction rules for continuity"

(* TODO: Cite Munkres *)

class \<Omega> =
  fixes \<Omega> :: "'a set"

class \<tau> =
  fixes \<tau> :: "'a set set"

class point_set_topology = \<Omega> + \<tau> +
  assumes space_subset_relative_universe: "\<tau> \<subseteq> Pow \<Omega>"
  assumes relative_universe_topological_membership [simp, intro]: "\<Omega> \<in> \<tau>"
  assumes Int_topological_closure [intro]: "S \<in> \<tau> \<Longrightarrow> T \<in> \<tau> \<Longrightarrow> S \<inter> T \<in> \<tau>"
  assumes Union_topological_closure [intro]: "K \<subseteq> \<tau> \<Longrightarrow> (\<Union> K) \<in> \<tau>"

begin

definition "open" :: "'a set \<Rightarrow> bool"
  where "open S \<longleftrightarrow> S \<in> \<tau>"

lemma open_relative_universe [simp, intro]: "open \<Omega>"
  unfolding open_def
  by fastforce

lemma open_Int [intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<inter> T)"
  unfolding open_def
  by fastforce

lemma open_Union [intro]: "\<forall>S\<in>K. open S \<Longrightarrow> open (\<Union>K)"
  unfolding open_def
  by blast

lemma open_empty [point_set_continuous_intros, intro, simp]: "open {}"
  using open_Union [of "{}"] by simp

lemma open_Un [point_set_continuous_intros, intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<union> T)"
  using open_Union [of "{S, T}"] by simp

lemma open_UN [point_set_continuous_intros, intro]: "\<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Union>x\<in>A. B x)"
  using open_Union [of "B ` A"] by simp

lemma open_Inter [point_set_continuous_intros, intro]:
  "finite S \<Longrightarrow> \<forall>T\<in>S. open T \<Longrightarrow> open (\<Omega> \<inter> \<Inter> S)"
  by (induct set: finite, simp, simp add: inf_left_commute open_Int)

lemma open_INT [point_set_continuous_intros, intro]:
  "finite A \<Longrightarrow> \<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Omega> \<inter> (\<Inter>x\<in> A. B x))"
  using open_Inter [of "B ` A"] by simp

lemma openI:
  assumes "\<And>x. x \<in> S \<Longrightarrow> \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S"
  shows "open S"
proof -
  have "open (\<Union>{T. open T \<and> T \<subseteq> S})" by auto
  moreover have "\<Union>{T. open T \<and> T \<subseteq> S} = S" by (auto dest!: assms)
  ultimately show "open S" by simp
qed

definition closed :: "'a set \<Rightarrow> bool"
  where "closed S \<longleftrightarrow> S \<subseteq> \<Omega> \<and> open (\<Omega> - S)"

lemma closed_empty [point_set_continuous_intros, intro, simp]: "closed {}"
  unfolding closed_def by auto

lemma closed_Un [point_set_continuous_intros, intro]: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<union> T)"
  unfolding closed_def
  by (simp add: Diff_Un open_Int)

lemma closed_relative_universe [point_set_continuous_intros, intro, simp]: "closed \<Omega>"
  unfolding closed_def
  by simp

lemma closed_Int [point_set_continuous_intros, intro]:
  "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<inter> T)"
  unfolding closed_def by (simp add: Diff_Int inf.coboundedI1 open_Un)

lemma closed_INT [point_set_continuous_intros, intro]:
  "\<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Omega> \<inter> (\<Inter> x\<in>A. B x))"
  unfolding closed_def
  by (metis (no_types, lifting) Diff_Int
                                Diff_cancel
                                IntE
                                UN_simps(7)
                                inf_commute
                                open_UN
                                subsetI
                                sup_bot.comm_neutral)

lemma closed_Inter [point_set_continuous_intros, intro]: "\<forall>S\<in>K. closed S \<Longrightarrow> closed (\<Omega> \<inter> \<Inter> K)"
  using closed_INT [where ?B="\<lambda> x. x"]
  by auto

lemma closed_Union [point_set_continuous_intros, intro]:
  "finite S \<Longrightarrow> \<forall>T\<in>S. closed T \<Longrightarrow> closed (\<Union>S)"
  by (induct set: finite) auto

lemma closed_UN [point_set_continuous_intros, intro]:
  "finite A \<Longrightarrow> \<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Union>x\<in>A. B x)"
  using closed_Union [of "B ` A"] by simp

lemma open_closed: "open S \<longleftrightarrow> S \<subseteq> \<Omega> \<and> closed (\<Omega> - S)"
proof
  assume "open S"
  hence "S \<subseteq> \<Omega>"
    unfolding open_def
    using space_subset_relative_universe
    by blast
  hence "\<Omega> - S \<subseteq> \<Omega>" "\<Omega> - (\<Omega> - S) = S"
    by auto
  with \<open>open S\<close> \<open>S \<subseteq> \<Omega>\<close> show "S \<subseteq> \<Omega> \<and> closed (\<Omega> - S)"
    unfolding closed_def
    by auto
next
  assume "S \<subseteq> \<Omega> \<and> closed (\<Omega> - S)"
  hence "\<Omega> - (\<Omega> - S) = S" "closed (\<Omega> - S)"
    by blast+
  thus "open S"
    unfolding closed_def
    by simp
qed

lemma closed_open: "closed S \<longleftrightarrow> S \<subseteq> \<Omega> \<and> open (\<Omega> - S)"
  by (rule closed_def)

lemma open_Diff [point_set_continuous_intros, intro]: "open S \<Longrightarrow> closed T \<Longrightarrow> open (S - T)"
  by (metis Int_Diff Int_absorb2 closed_open open_Int open_closed)

lemma closed_Diff [point_set_continuous_intros, intro]: "closed S \<Longrightarrow> open T \<Longrightarrow> closed (S - T)"
  by (metis Int_Diff Int_absorb2 closed_Int closed_open open_closed)

lemma open_Compl [point_set_continuous_intros, intro]: "closed S \<Longrightarrow> open (\<Omega> - S)"
  by blast

lemma closed_Compl [point_set_continuous_intros, intro]: "open S \<Longrightarrow> closed (\<Omega> - S)"
  by blast

lemma open_Collect_neg: "closed {x. P x} \<Longrightarrow> open {x \<in> \<Omega>. \<not> P x}"
proof -
  assume "closed {x. P x}"
  hence "closed {x \<in> \<Omega>. P x}"
    by (simp add: Collect_conj_eq closed_Int)
  hence "open (\<Omega> - {x \<in> \<Omega>. P x})" "\<Omega> - {x \<in> \<Omega>. P x} = {x \<in> \<Omega>. \<not> P x}"
    unfolding closed_def
    by blast+
  thus "open {x \<in> \<Omega>. \<not> P x}" by auto
qed

lemma closed_Collect_neg: "open {x. P x} \<Longrightarrow> closed {x \<in> \<Omega>. \<not> P x}"
proof -
  assume "open {x. P x}"
  hence "open {x \<in> \<Omega>. P x}"
    by (simp add: Collect_conj_eq open_Int)
  hence "closed (\<Omega> - {x \<in> \<Omega>. P x})" "\<Omega> - {x \<in> \<Omega>. P x} = {x \<in> \<Omega>. \<not> P x}"
    unfolding open_closed
    by blast+
  thus "closed {x \<in> \<Omega>. \<not> P x}" by auto
qed

lemma open_Collect_neg_eq:
  "open {x \<in> \<Omega>. P x} \<longleftrightarrow> closed {x \<in> \<Omega>. \<not> P x}"
proof
  assume "open {x \<in> \<Omega>. P x}"
  hence "open {x. x \<in> \<Omega> \<and> P x}"
    by auto
  hence "closed {x \<in> \<Omega>. \<not> x \<in> \<Omega> \<or> \<not> P x}"
    using closed_Collect_neg by force
  thus "closed {x \<in> \<Omega>. \<not> P x}"
    by (metis (mono_tags, lifting) Collect_cong)
next
  assume "closed {x \<in> \<Omega>. \<not> P x}"
  hence "closed {x. x \<in> \<Omega> \<and> \<not> P x}"
    by auto
  hence "open {x \<in> \<Omega>. \<not> x \<in> \<Omega> \<or> P x}"
    using open_Collect_neg by force
  thus "open {x \<in> \<Omega>. P x}"
    by (metis (mono_tags, lifting) Collect_cong)
qed

lemma open_Collect_conj:
  assumes "open {x. P x}" "open {x. Q x}"
  shows "open {x. P x \<and> Q x}"
  using open_Int[OF assms] by (simp add: Int_def)

lemma open_Collect_disj:
  assumes "open {x. P x}" "open {x. Q x}"
  shows "open {x. P x \<or> Q x}"
  using open_Un[OF assms] by (simp add: Un_def)

lemma open_Collect_ex: "(\<And>i. open {x. P i x}) \<Longrightarrow> open {x. \<exists>i. P i x}"
  using open_UN[of UNIV "\<lambda>i. {x. P i x}"] unfolding Collect_ex_eq by simp

lemma weakend_open_Collect_ex:
  assumes "\<And>i. open {x \<in> \<Omega>. P i x}"
  shows "open {x \<in> \<Omega>. \<exists>i. P i x}"
proof -
  have "open {x. \<exists>i. x \<in> \<Omega> \<and> P i x}"
    using assms open_Collect_ex [where ?P="\<lambda> i x. x \<in> \<Omega> \<and> P i x"]
    by blast
  moreover have "{x. \<exists>i. x \<in> \<Omega> \<and> P i x} = {x \<in> \<Omega>. \<exists>i. P i x}"
    by blast
  ultimately show ?thesis by simp
qed

lemma open_Collect_imp:
  assumes "open {x. \<not> P x}" "open {x. Q x}"
  shows "open {x. P x \<longrightarrow> Q x}"
proof -
  from assms have "open {x. \<not> P x \<or> Q x}"
    using open_Collect_disj by blast
  thus ?thesis
    by linarith
qed

lemma open_Collect_const: "open {x \<in> \<Omega>. P}"
  by (cases P) auto

lemma closed_Collect_conj:
  assumes "closed {x. P x}" "closed {x. Q x}"
  shows "closed {x. P x \<and> Q x}"
  using closed_Int[OF assms] by (simp add: Int_def)

lemma closed_Collect_disj:
  assumes "closed {x. P x}" "closed {x. Q x}"
  shows "closed {x. P x \<or> Q x}"
  using closed_Un[OF assms] by (simp add: Un_def)

lemma closed_Collect_imp: "closed {x. \<not> P x} \<Longrightarrow> closed {x. Q x} \<Longrightarrow> closed {x. P x \<longrightarrow> Q x}"
  unfolding imp_conv_disj
  using closed_Collect_disj
  by blast

lemma closed_Collect_all:
  assumes "\<And>i. closed {x. P i x}"
  shows "closed {x . \<forall>i. P i x}"
proof -
  from assms have "\<forall>i . {x. P i x} = {x \<in> \<Omega>. P i x}"
    unfolding closed_def
    by blast
  with assms have "\<And>i. closed {x \<in> \<Omega>. P i x}"
    by simp
  hence "\<And>i. open {x \<in> \<Omega>. \<not> P i x}"
    by (simp add: assms open_Collect_neg)
  hence "closed {x \<in> \<Omega>. \<forall> i. P i x}"
    using weakend_open_Collect_ex [where ?P="\<lambda> i x. \<not> P i x"]
          open_Collect_neg_eq
    by fastforce
  moreover from assms have "{x \<in> \<Omega>. \<forall> i. P i x} = {x . \<forall> i. P i x}"
    unfolding closed_def
    by blast
  ultimately show ?thesis by auto
qed

lemma weakend_closed_Collect_all:
  assumes "\<And>i. closed {x \<in> \<Omega>. P i x}"
  shows "closed {x \<in> \<Omega>. \<forall>i. P i x}"
proof -
  from assms have "closed {x . \<forall>i. x \<in> \<Omega> \<and> P i x}"
    using closed_Collect_all [where ?P="\<lambda> i x. x \<in> \<Omega> \<and> P i x"]
    by blast
  moreover have "{x . \<forall>i. x \<in> \<Omega> \<and> P i x} = {x \<in> \<Omega> . \<forall>i. P i x}"
    by auto
  ultimately show ?thesis by simp
qed

lemma closed_Collect_const: "closed {x \<in> \<Omega>. P}"
  by (cases P) auto

end

class t0_topology = point_set_topology +
  assumes t0_topology: "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>U \<in> \<tau>. \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"

lemma (in t0_topology) t0_space:
  "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
  unfolding open_def
  using t0_topology by auto

class t1_topology = point_set_topology +
  assumes t1_topology: "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>U \<in> \<tau>. x \<in> U \<and> y \<notin> U"

instance t1_topology \<subseteq> t0_topology
  by standard (metis t1_topology)

context t1_topology begin

lemma t1_space: "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> x \<in> U \<and> y \<notin> U"
  by (meson open_def t1_topology)

lemma separation_t1: "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> x \<in> U \<and> y \<notin> U)"
  using t1_space[of x y] by blast

lemma closed_singleton:
  assumes "a \<in> \<Omega>"
  shows "closed {a}"
proof -
  let ?T = "\<Union>{S. open S \<and> a \<notin> S}"
  have "open ?T"
    by (simp add: open_Union)
  moreover have "?T = \<Omega> - {a}"
    using t1_space
    by (auto, fastforce simp add: open_closed)
  ultimately show ?thesis
    using \<open>a \<in> \<Omega>\<close>
    unfolding closed_def
    by auto
qed

lemma closed_insert [point_set_continuous_intros, simp]:
  assumes "a \<in> \<Omega>"
      and "closed S"
    shows "closed (insert a S)"
proof -
  from closed_singleton assms have "closed ({a} \<union> S)"
    by blast
  then show "closed (insert a S)"
    by simp
qed

lemma finite_imp_closed:
  assumes "finite S"
      and "S \<subseteq> \<Omega>"
    shows "closed S"
  using assms
  by (induct pred: finite) simp_all

end

text \<open>T2 spaces are also known as Hausdorff spaces.\<close>

class t2_topology = point_set_topology +
  assumes hausdorff:
    "x \<in> \<Omega> \<Longrightarrow> y \<in> \<Omega> \<Longrightarrow> x \<noteq> y \<Longrightarrow> \<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"

instance t2_topology \<subseteq> t1_topology
  by standard (metis IntI empty_iff hausdorff)

lemma (in t2_topology) separation_t2:
  assumes "x \<in> \<Omega>"
      and "y \<in> \<Omega>"
    shows "x \<noteq> y \<longleftrightarrow> (\<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
  using assms hausdorff [of x y]
  by blast

lemma (in t0_topology) separation_t0:
  assumes "x \<in> \<Omega>"
      and "y \<in> \<Omega>"
    shows "x \<noteq> y \<longleftrightarrow> (\<exists>U \<in> \<tau>. \<not> (x \<in> U \<longleftrightarrow> y \<in> U))"
  using assms t0_topology [of x y]
  by blast

text \<open>A classical separation axiom for topological space, the T3 axiom -- also called regularity:
if a point is not in a closed set, then there are open sets separating them.\<close>

class t3_topology = t2_topology +
  assumes t3_topology:
    "y \<in> \<Omega> \<Longrightarrow>
     S \<subseteq> \<Omega> \<Longrightarrow>
     \<Omega> - S \<in> \<tau> \<Longrightarrow>
     y \<notin> S \<Longrightarrow>
     \<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"

text \<open>A classical separation axiom for topological space, the T4 axiom -- also called normality:
if two closed sets are disjoint, then there are open sets separating them.\<close>

class t4_topology = t2_topology +
  assumes t4_topology:
    "S \<subseteq> \<Omega> \<Longrightarrow>
     T \<subseteq> \<Omega> \<Longrightarrow>
     \<Omega> - S \<in> \<tau> \<Longrightarrow>
     \<Omega> - T \<in> \<tau> \<Longrightarrow>
     S \<inter> T = {} \<Longrightarrow>
     \<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> U \<inter> V = {}"

text \<open>T4 is stronger than T3, and weaker than metric.\<close>

instance t4_topology \<subseteq> t3_topology
proof
  fix S and y::'a assume "y \<in> \<Omega>" "S \<subseteq> \<Omega>" "\<Omega> - S \<in> \<tau>" "y \<notin> S"
  then show "\<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"
    using t4_topology[of "{y}" S]
    by (metis (no_types, lifting)
              Diff_disjoint
              Diff_insert_absorb
              closed_empty
              closed_insert
              closed_open
              open_def
              singletonI subsetCE)
qed

text \<open>A perfect space is a topological space with no isolated points.\<close>

class perfect_topology = point_set_topology +
  assumes not_open_singleton: "x \<in> \<Omega> \<Longrightarrow> {x} \<notin> \<tau>"

lemma (in perfect_topology) UNIV_not_singleton: "\<Omega> \<noteq> {x}"
  for x::'a
  using not_open_singleton
        relative_universe_topological_membership
  by blast

subsection \<open>Generators for toplogies\<close>

inductive generate_topology :: "'a set set \<Rightarrow> 'a set \<Rightarrow> bool" for S :: "'a set set"
  where
    Int: "generate_topology S a \<Longrightarrow> generate_topology S b \<Longrightarrow> generate_topology S (a \<inter> b)"
  | UN: "generate_topology S (\<Union>K)" if "(\<And>k. k \<in> K \<Longrightarrow> generate_topology S k)"
  | Basis: "generate_topology S s" if "s \<in> S"

hide_fact (open) Int UN Basis

lemma generate_topology_Union:
  "(\<And>k. k \<in> I \<Longrightarrow> generate_topology S (K k)) \<Longrightarrow> generate_topology S (\<Union>k\<in>I. K k)"
  using generate_topology.UN [of "K ` I"] by auto

lemma generate_topology_\<Omega>: "generate_topology S (\<Union>S)"
  by (simp add: generate_topology.Basis generate_topology.UN)

lemma generate_topology_Collect_Pow:
  "Collect (generate_topology S) \<subseteq> Pow (\<Union>S)"
proof -
  {
    fix x
    assume "generate_topology S x"
    hence "x \<in> Pow (\<Union>S)"
      by (induct x, blast+)
  }
  thus ?thesis
    by blast
qed

lemma topological_space_generate_topology:
  "class.point_set_topology (\<Union>S) (Collect (generate_topology S))"
  by (standard,
      simp add: generate_topology_Collect_Pow,
      simp add: generate_topology_\<Omega>,
      simp add: generate_topology.Int,
      metis Ball_Collect generate_topology.UN mem_Collect_eq)

subsection \<open>Order topologies\<close>

class order_topology = order + \<Omega> + \<tau> +
  assumes open_generated_order:
    "\<tau> = Collect (generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..})))"
  assumes \<Omega>_union_\<tau>: "\<Omega> = \<Union>\<tau>"
begin

subclass point_set_topology
  unfolding open_generated_order \<Omega>_union_\<tau>
  by (standard,
      blast,
      force intro: generate_topology.UN,
      simp add: generate_topology.Int,
      metis Ball_Collect CollectI generate_topology.UN)

lemma open_greaterThan [point_set_continuous_intros, simp]: "open {a <..}"
  unfolding open_generated_order
  by (metis CollectI
            IntD2
            generate_topology.Basis
            inf_sup_absorb
            open_def
            open_generated_order
            range_eqI
            sup_commute)

lemma open_lessThan [point_set_continuous_intros, simp]: "open {..< a}"
  unfolding open_generated_order
  by (metis (no_types, lifting)
            Un_def
            generate_topology.Basis
            open_def
            open_generated_order
            mem_Collect_eq rangeI)

lemma open_greaterThanLessThan [point_set_continuous_intros, simp]: "open {a <..< b}"
   unfolding greaterThanLessThan_eq by (simp add: open_Int)
end

class nonempty_topology = point_set_topology +
  assumes nonempty_\<Omega>: "\<Omega> \<noteq> {}"

class linorder_topology = linorder + order_topology + nonempty_topology

begin

lemma \<Omega>_UNIV: "\<Omega> = UNIV"
proof -
  from nonempty_\<Omega> obtain a S where "a \<in> \<Omega>" "S \<in> \<tau>" "a \<in> S"
    by blast
  have "UNIV = {..< a} \<union> S \<union> {a <..}"
    using UnI1 \<open>a \<in> S\<close> not_less_iff_gr_or_eq by auto
  thus ?thesis
    by (metis UNIV_I UNIV_eq_I UnionI \<Omega>_union_\<tau>
              \<open>S \<in> \<tau>\<close> open_Un open_def
              open_greaterThan open_lessThan)
qed

lemma open_closed: "open S = closed (- S)"
  by (metis Compl_eq_Diff_UNIV \<Omega>_UNIV double_compl closed_Compl open_Compl)

lemma closed_open: "closed S = open (- S)"
  by (simp add: open_closed)

end

lemma closed_atMost [point_set_continuous_intros, simp]: "closed {..a}"
  for a :: "'a::linorder_topology"
  by (simp add: closed_open)

lemma closed_atLeast [point_set_continuous_intros, simp]: "closed {a..}"
  for a :: "'a::linorder_topology"
  by (simp add: closed_open)

lemma closed_atLeastAtMost [point_set_continuous_intros, simp]: "closed {a..b}"
  for a b :: "'a::linorder_topology"
proof -
  have "{a .. b} = {a ..} \<inter> {.. b}"
    by auto
  then show ?thesis
    by (simp add: closed_Int)
qed

lemma (in linorder) less_separate:
  assumes "x < y"
  shows "\<exists>a b. x \<in> {..< a} \<and> y \<in> {b <..} \<and> {..< a} \<inter> {b <..} = {}"
proof (cases "\<exists>z. x < z \<and> z < y")
  case True
  then obtain z where "x < z \<and> z < y" ..
  then have "x \<in> {..< z} \<and> y \<in> {z <..} \<and> {z <..} \<inter> {..< z} = {}"
    by auto
  then show ?thesis by blast
next
  case False
  with \<open>x < y\<close> have "x \<in> {..< y}" "y \<in> {x <..}" "{x <..} \<inter> {..< y} = {}"
    by auto
  then show ?thesis by blast
qed

instance linorder_topology \<subseteq> t2_topology
proof
  fix x y :: 'a
  show "    x \<in> \<Omega>
        \<Longrightarrow> y \<in> \<Omega>
        \<Longrightarrow> x \<noteq> y
        \<Longrightarrow> \<exists>U V. U \<in> \<tau> \<and> V \<in> \<tau> \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
    using less_separate [of x y] less_separate [of y x]
    by (metis inf_commute linorder_cases open_def open_greaterThan open_lessThan)
qed

lemma (in linorder_topology) open_right:
  assumes "open S" "x \<in> S"
      and gt_ex: "x < y"
    shows "\<exists>b>x. {x ..< b} \<subseteq> S"
    using assms unfolding open_generated_order
proof -
  from \<open>open S\<close>
  have "generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..})) S"

end


(*  Title:      ZF/Nat_ZF.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section\<open>The Natural numbers As a Least Fixed Point\<close>

theory Nat_ZF imports OrdQuant Bool begin

definition
  nat :: i  where
    "nat == lfp(Inf, %X. {0} \<union> {succ(i). i \<in> X})"

definition
  quasinat :: "i => o"  where
    "quasinat(n) == n=0 | (\<exists>m. n = succ(m))"

definition
  (*Has an unconditional succ case, which is used in "recursor" below.*)
  nat_case :: "[i, i=>i, i]=>i"  where
    "nat_case(a,b,k) == THE y. k=0 & y=a | (\<exists>x. k=succ(x) & y=b(x))"

definition
  nat_rec :: "[i, i, [i,i]=>i]=>i"  where
    "nat_rec(k,a,b) ==
          wfrec(Memrel(nat), k, %n f. nat_case(a, %m. b(m, f`m), n))"

  (*Internalized relations on the naturals*)

definition
  Le :: i  where
    "Le == {<x,y>:nat*nat. x \<le> y}"

definition
  Lt :: i  where
    "Lt == {<x, y>:nat*nat. x < y}"

definition
  Ge :: i  where
    "Ge == {<x,y>:nat*nat. y \<le> x}"

definition
  Gt :: i  where
    "Gt == {<x,y>:nat*nat. y < x}"

definition
  greater_than :: "i=>i"  where
    "greater_than(n) == {i \<in> nat. n < i}"

text\<open>No need for a less-than operator: a natural number is its list of
predecessors!\<close>

lemma nat_bnd_mono: "bnd_mono(Inf, %X. {0} \<union> {succ(i). i \<in> X})"
apply (rule bnd_monoI)
apply (cut_tac infinity, blast, blast)
done

(* @{term"nat = {0} \<union> {succ(x). x \<in> nat}"} *)
lemmas nat_unfold = nat_bnd_mono [THEN nat_def [THEN def_lfp_unfold]]

(** Type checking of 0 and successor **)

lemma nat_0I [iff,TC]: "0 \<in> nat"
apply (subst nat_unfold)
apply (rule singletonI [THEN UnI1])
done

lemma nat_succI [intro!,TC]: "n \<in> nat ==> succ(n) \<in> nat"
apply (subst nat_unfold)
apply (erule RepFunI [THEN UnI2])
done

lemma nat_1I [iff,TC]: "1 \<in> nat"
by (rule nat_0I [THEN nat_succI])

lemma nat_2I [iff,TC]: "2 \<in> nat"
by (rule nat_1I [THEN nat_succI])

lemma bool_subset_nat: "bool \<subseteq> nat"
by (blast elim!: boolE)

lemmas bool_into_nat = bool_subset_nat [THEN subsetD]

subsection\<open>Injectivity Properties and Induction\<close>

(*Mathematical induction*)
lemma nat_induct [case_names 0 succ, induct set: nat]:
    "[| n \<in> nat;  P(0);  !!x. [| x \<in> nat;  P(x) |] ==> P(succ(x)) |] ==> P(n)"
by (erule def_induct [OF nat_def nat_bnd_mono], blast)

lemma natE:
 assumes "n \<in> nat"
 obtains ("0") "n=0" | (succ) x where "x \<in> nat" "n=succ(x)"
using assms
by (rule nat_unfold [THEN equalityD1, THEN subsetD, THEN UnE]) auto

lemma nat_into_Ord [simp]: "n \<in> nat ==> Ord(n)"
by (erule nat_induct, auto)

(* @{term"i \<in> nat ==> 0 \<le> i"}; same thing as @{term"0<succ(i)"}  *)
lemmas nat_0_le = nat_into_Ord [THEN Ord_0_le]

(* @{term"i \<in> nat ==> i \<le> i"}; same thing as @{term"i<succ(i)"}  *)
lemmas nat_le_refl = nat_into_Ord [THEN le_refl]

lemma Ord_nat [iff]: "Ord(nat)"
apply (rule OrdI)
apply (erule_tac [2] nat_into_Ord [THEN Ord_is_Transset])
apply (unfold Transset_def)
apply (rule ballI)
apply (erule nat_induct, auto)
done

lemma Limit_nat [iff]: "Limit(nat)"
apply (unfold Limit_def)
apply (safe intro!: ltI Ord_nat)
apply (erule ltD)
done

lemma naturals_not_limit: "a \<in> nat ==> ~ Limit(a)"
by (induct a rule: nat_induct, auto)

lemma succ_natD: "succ(i): nat ==> i \<in> nat"
by (rule Ord_trans [OF succI1], auto)

lemma nat_succ_iff [iff]: "succ(n): nat \<longleftrightarrow> n \<in> nat"
by (blast dest!: succ_natD)

lemma nat_le_Limit: "Limit(i) ==> nat \<le> i"
apply (rule subset_imp_le)
apply (simp_all add: Limit_is_Ord)
apply (rule subsetI)
apply (erule nat_induct)
 apply (erule Limit_has_0 [THEN ltD])
apply (blast intro: Limit_has_succ [THEN ltD] ltI Limit_is_Ord)
done

(* [| succ(i): k;  k \<in> nat |] ==> i \<in> k *)
lemmas succ_in_naturalD = Ord_trans [OF succI1 _ nat_into_Ord]

lemma lt_nat_in_nat: "[| m<n;  n \<in> nat |] ==> m \<in> nat"
apply (erule ltE)
apply (erule Ord_trans, assumption, simp)
done

lemma le_in_nat: "[| m \<le> n; n \<in> nat |] ==> m \<in> nat"
by (blast dest!: lt_nat_in_nat)

subsection\<open>Variations on Mathematical Induction\<close>

(*complete induction*)

lemmas complete_induct = Ord_induct [OF _ Ord_nat, case_names less, consumes 1]

lemmas complete_induct_rule =
        complete_induct [rule_format, case_names less, consumes 1]

lemma nat_induct_from_lemma [rule_format]:
    "[| n \<in> nat;  m \<in> nat;
        !!x. [| x \<in> nat;  m \<le> x;  P(x) |] ==> P(succ(x)) |]
     ==> m \<le> n \<longrightarrow> P(m) \<longrightarrow> P(n)"
apply (erule nat_induct)
apply (simp_all add: distrib_simps le0_iff le_succ_iff)
done

(*Induction starting from m rather than 0*)
lemma nat_induct_from:
    "[| m \<le> n;  m \<in> nat;  n \<in> nat;
        P(m);
        !!x. [| x \<in> nat;  m \<le> x;  P(x) |] ==> P(succ(x)) |]
     ==> P(n)"
apply (blast intro: nat_induct_from_lemma)
done

(*Induction suitable for subtraction and less-than*)
lemma diff_induct [case_names 0 0_succ succ_succ, consumes 2]:
    "[| m \<in> nat;  n \<in> nat;
        !!x. x \<in> nat ==> P(x,0);
        !!y. y \<in> nat ==> P(0,succ(y));
        !!x y. [| x \<in> nat;  y \<in> nat;  P(x,y) |] ==> P(succ(x),succ(y)) |]
     ==> P(m,n)"
apply (erule_tac x = m in rev_bspec)
apply (erule nat_induct, simp)
apply (rule ballI)
apply (rename_tac i j)
apply (erule_tac n=j in nat_induct, auto)
done

(** Induction principle analogous to trancl_induct **)

lemma succ_lt_induct_lemma [rule_format]:
     "m \<in> nat ==> P(m,succ(m)) \<longrightarrow> (\<forall>x\<in>nat. P(m,x) \<longrightarrow> P(m,succ(x))) \<longrightarrow>
                 (\<forall>n\<in>nat. m<n \<longrightarrow> P(m,n))"
apply (erule nat_induct)
 apply (intro impI, rule nat_induct [THEN ballI])
   prefer 4 apply (intro impI, rule nat_induct [THEN ballI])
apply (auto simp add: le_iff)
done

lemma succ_lt_induct:
    "[| m<n;  n \<in> nat;
        P(m,succ(m));
        !!x. [| x \<in> nat;  P(m,x) |] ==> P(m,succ(x)) |]
     ==> P(m,n)"
by (blast intro: succ_lt_induct_lemma lt_nat_in_nat)

subsection\<open>quasinat: to allow a case-split rule for @{term nat_case}\<close>

text\<open>True if the argument is zero or any successor\<close>

lemma [iff]: "quasinat(succ(x))"
by (simp add: quasinat_def)

lemma nat_imp_quasinat: "n \<in> nat ==> quasinat(n)"
by (erule natE, simp_all)

lemma non_nat_case: "~ quasinat(x) ==> nat_case(a,b,x) = 0"
by (simp add: quasinat_def nat_case_def)

lemma nat_cases_disj: "k=0 | (\<exists>y. k = succ(y)) | ~ quasinat(k)"
apply (case_tac "k=0", simp)
apply (case_tac "\<exists>m. k = succ(m)")
apply (simp_all add: quasinat_def)
done

lemma nat_cases:
     "[|k=0 ==> P;  !!y. k = succ(y) ==> P; ~ quasinat(k) ==> P|] ==> P"
by (insert nat_cases_disj [of k], blast)

(** nat_case **)

lemma nat_case_0 [simp]: "nat_case(a,b,0) = a"
by (simp add: nat_case_def)

lemma nat_case_succ [simp]: "nat_case(a,b,succ(n)) = b(n)"
by (simp add: nat_case_def)

lemma nat_case_type [TC]:
    "[| n \<in> nat;  a \<in> C(0);  !!m. m \<in> nat ==> b(m): C(succ(m)) |]
     ==> nat_case(a,b,n) \<in> C(n)"
by (erule nat_induct, auto)

lemma split_nat_case:
  "P(nat_case(a,b,k)) \<longleftrightarrow>
   ((k=0 \<longrightarrow> P(a)) & (\<forall>x. k=succ(x) \<longrightarrow> P(b(x))) & (~ quasinat(k) \<longrightarrow> P(0)))"
apply (rule nat_cases [of k])
apply (auto simp add: non_nat_case)
done

subsection\<open>Recursion on the Natural Numbers\<close>

(** nat_rec is used to define eclose and transrec, then becomes obsolete.
    The operator rec, from arith.thy, has fewer typing conditions **)

lemma nat_rec_0: "nat_rec(0,a,b) = a"
apply (rule nat_rec_def [THEN def_wfrec, THEN trans])
 apply (rule wf_Memrel)
apply (rule nat_case_0)
done

lemma nat_rec_succ: "m \<in> nat ==> nat_rec(succ(m),a,b) = b(m, nat_rec(m,a,b))"
apply (rule nat_rec_def [THEN def_wfrec, THEN trans])
 apply (rule wf_Memrel)
apply (simp add: vimage_singleton_iff)
done

(** The union of two natural numbers is a natural number -- their maximum **)

lemma Un_nat_type [TC]: "[| i \<in> nat; j \<in> nat |] ==> i \<union> j \<in> nat"
apply (rule Un_least_lt [THEN ltD])
apply (simp_all add: lt_def)
done

lemma Int_nat_type [TC]: "[| i \<in> nat; j \<in> nat |] ==> i \<inter> j \<in> nat"
apply (rule Int_greatest_lt [THEN ltD])
apply (simp_all add: lt_def)
done

(*needed to simplify unions over nat*)
lemma nat_nonempty [simp]: "nat \<noteq> 0"
by blast

text\<open>A natural number is the set of its predecessors\<close>
lemma nat_eq_Collect_lt: "i \<in> nat ==> {j\<in>nat. j<i} = i"
apply (rule equalityI)
apply (blast dest: ltD)
apply (auto simp add: Ord_mem_iff_lt)
apply (blast intro: lt_trans)
done

lemma Le_iff [iff]: "<x,y> \<in> Le \<longleftrightarrow> x \<le> y & x \<in> nat & y \<in> nat"
by (force simp add: Le_def)

end