(******************************************************************************)
(* Project: Isabelle/UTP: Unifying Theories of Programming in Isabelle/HOL    *)
(* File: unrest.thy                                                           *)
(* Authors: Frank Zeyda and Simon Foster (University of York, UK)             *)
(* Emails: frank.zeyda@gmail.com and simon.foster@york.ac.uk                  *)
(******************************************************************************)
(* LAST REVIEWED: 09 Jun 2022 *)

section \<open>Unrestriction\<close>

theory unrest
imports upred
begin

subsection \<open>Definition\<close>

lift_definition unrest :: "uvar set \<Rightarrow> upred \<Rightarrow> bool" (infix "\<sharp>" 50)
is "\<lambda>vs bs. \<forall>b1\<in>bs. \<forall>b2. b1 \<oplus>\<^sub>s b2 on vs \<in> bs"
done

subsection \<open>Theorems\<close>

theorem TrueP_unrest (*[unrest]*):
"v \<sharp> TrueP"
apply (transfer)
apply (simp)
done

theorem FalseP_unrest (*[unrest]*):
"v \<sharp> FalseP"
apply (transfer)
apply (simp)
done
end


(*<*)
theory CJDDLplus
  imports Main
begin
nitpick_params[user_axioms=true, show_all, expect=genuine, format = 3]
(*>*)

section \<open>Introduction\<close>
text\<open>\noindent{We present an encoding of an ambitious ethical theory ---Alan Gewirth's "Principle of Generic Consistency (PGC)"---
in Isabelle/HOL. The PGC has stirred much attention in philosophy and ethics @{cite "Beyleveld"} and has been proposed as a
potential means to bound the impact of artificial general intelligence (AGI) @{cite "Kornai"}.
With our contribution we make a first, important step towards formally assessing the PGC and its potential applications in AI.
Our formalisation utilises the shallow semantical embedding approach @{cite "J23"}
and adapts a recent embedding of dyadic deontic logic in HOL @{cite "C71"} @{cite "BenzmuellerDDL"}.
}\<close>

section \<open>Semantic Embedding of Carmo and Jones' Dyadic Deontic Logic (DDL) augmented with Kaplanian contexts\<close>

text\<open>\noindent{We introduce a modification of the semantic embedding developed by Benzm\"uller et al. @{cite "C71"} @{cite "BenzmuellerDDL"}
for the Dyadic Deontic Logic originally presented by Carmo and Jones @{cite "CJDDL"}. We extend this embedding
to a two-dimensional semantics as originally presented by David Kaplan @{cite "Kaplan1979"} @{cite "Kaplan1989"}.}\<close>

subsection \<open>Definition of Types\<close>

typedecl w   \<comment> \<open>  Type for possible worlds (Kaplan's "circumstances of evaluation" or "counterfactual situations")  \<close>
typedecl e   \<comment> \<open>  Type for individuals (entities eligible to become agents) \<close>
typedecl c   \<comment> \<open>  Type for Kaplanian "contexts of use" \<close>
type_synonym wo = "w\<Rightarrow>bool" \<comment> \<open>  contents/propositions are identified with their truth-sets \<close>
type_synonym cwo = "c\<Rightarrow>wo"  \<comment> \<open>  sentence meaning (Kaplan's "character") is a function from contexts to contents \<close>
type_synonym m = "cwo"      \<comment> \<open>  we use the letter 'm' for characters (reminiscent of "meaning") \<close>

subsection \<open>Semantic Characterisation of DDL\<close> (*cf. original Carmo and Jones Paper @{cite "CJDDL"} p.290ff*)

subsubsection \<open>Basic Set Operations\<close>
abbreviation subset::"wo\<Rightarrow>wo\<Rightarrow>bool" (infix "\<sqsubseteq>" 46) where "\<alpha> \<sqsubseteq> \<beta> \<equiv> \<forall>w. \<alpha> w  \<longrightarrow> \<beta> w"
abbreviation intersection::"wo\<Rightarrow>wo\<Rightarrow>wo" (infixr "\<sqinter>" 48) where "\<alpha> \<sqinter> \<beta> \<equiv> \<lambda>x. \<alpha> x \<and> \<beta> x"
abbreviation union::"wo\<Rightarrow>wo\<Rightarrow>wo" (infixr "\<squnion>" 48) where "\<alpha> \<squnion> \<beta> \<equiv> \<lambda>x. \<alpha> x \<or> \<beta> x"
abbreviation complement::"wo\<Rightarrow>wo" ("\<sim>_"[45]46) where "\<sim>\<alpha> \<equiv> \<lambda>x. \<not>\<alpha> x"
abbreviation instantiated::"wo\<Rightarrow>bool" ("\<I>_"[45]46) where "\<I> \<phi> \<equiv> \<exists>x. \<phi> x"
abbreviation setEq::"wo\<Rightarrow>wo\<Rightarrow>bool" (infix "=\<^sub>s" 46) where "\<alpha> =\<^sub>s \<beta> \<equiv> \<forall>x. \<alpha> x \<longleftrightarrow> \<beta> x"
abbreviation univSet :: "wo" ("\<top>") where "\<top> \<equiv> \<lambda>w. True"
abbreviation emptySet :: "wo" ("\<bottom>") where "\<bottom> \<equiv> \<lambda>w. False"

subsubsection \<open>Set-Theoretic Conditions for DDL\<close>

consts
av::"w\<Rightarrow>wo"   \<comment> \<open> set of worlds that are open alternatives (aka. actual versions) of w \<close>
pv::"w\<Rightarrow>wo"   \<comment> \<open> set of worlds that are possible alternatives (aka. potential versions) of w \<close>
ob::"wo\<Rightarrow>wo\<Rightarrow>bool" \<comment> \<open> set of propositions which are obligatory in a given context (of type wo)  \<close>

axiomatization where
sem_3a: "\<forall>w. \<I>(av w)" and \<comment> \<open>  av is serial: in every situation there is always an open alternative \<close>
sem_4a: "\<forall>w. av w \<sqsubseteq> pv w" and \<comment> \<open>  open alternatives are possible alternatives \<close>
sem_4b: "\<forall>w. pv w w" and \<comment> \<open>  pv is reflexive: every situation is a possible alternative to itself \<close>
sem_5a: "\<forall>X. \<not>(ob X \<bottom>)" and \<comment> \<open>  contradictions cannot be obligatory \<close>
sem_5b: "\<forall>X Y Z. (X \<sqinter> Y) =\<^sub>s (X \<sqinter> Z) \<longrightarrow> (ob X Y \<longleftrightarrow> ob X Z)" and
sem_5c: "\<forall>X Y Z. \<I>(X \<sqinter> Y \<sqinter> Z) \<and> ob X Y \<and> ob X Z \<longrightarrow> ob X (Y \<sqinter> Z)" and
sem_5d: "\<forall>X Y Z. (Y \<sqsubseteq> X \<and> ob X Y \<and> X \<sqsubseteq> Z) \<longrightarrow> ob Z ((Z \<sqinter> (\<sim>X)) \<squnion> Y)" and
sem_5e: "\<forall>X Y Z. Y \<sqsubseteq> X \<and> ob X Z \<and> \<I>(Y \<sqinter> Z) \<longrightarrow> ob Y Z"

lemma True nitpick[satisfy] oops \<comment> \<open> model found: axioms are consistent \<close>

subsubsection \<open>Verifying Semantic Conditions\<close>

lemma sem_5b1: "ob X Y \<longrightarrow> ob X (Y \<sqinter> X)" by (metis (no_types, lifting) sem_5b)
lemma sem_5b2: "(ob X (Y \<sqinter> X) \<longrightarrow> ob X Y)" by (metis (no_types, lifting) sem_5b)
lemma sem_5ab: "ob X Y \<longrightarrow> \<I>(X \<sqinter> Y)" by (metis (full_types) sem_5a sem_5b)
lemma sem_5bd1: "Y \<sqsubseteq> X \<and> ob X Y \<and> X \<sqsubseteq> Z \<longrightarrow> ob Z ((\<sim>X) \<squnion> Y)" using sem_5b sem_5d by smt
lemma sem_5bd2: "ob X Y \<and> X \<sqsubseteq> Z \<longrightarrow> ob Z ((Z \<sqinter> (\<sim>X)) \<squnion> Y)"  using sem_5b sem_5d  by (smt sem_5b1)
lemma sem_5bd3: "ob X Y \<and> X \<sqsubseteq> Z \<longrightarrow> ob Z ((\<sim>X) \<squnion> Y)"  by (smt sem_5bd2 sem_5b)
lemma sem_5bd4: "ob X Y \<and> X \<sqsubseteq> Z \<longrightarrow> ob Z ((\<sim>X) \<squnion> (X \<sqinter>  Y))" using sem_5bd3 by auto
lemma sem_5bcd: "(ob X Z \<and> ob Y Z) \<longrightarrow> ob (X \<squnion> Y) Z" using sem_5b sem_5c sem_5d oops

(* 5e and 5ab justify redefinition of @{cite "O\<langle>\<phi>|\<sigma>\<rangle>"} as (ob A B)*)
lemma "ob A B \<longleftrightarrow>  (\<I>(A \<sqinter> B) \<and> (\<forall>X. X \<sqsubseteq> A \<and> \<I>(X \<sqinter> B) \<longrightarrow> ob X B))" using sem_5e sem_5ab by blast

subsection \<open>(Shallow) Semantic Embedding of DDL\<close>

subsubsection \<open>Basic Propositional Logic\<close>
abbreviation pand::"m\<Rightarrow>m\<Rightarrow>m" (infixr"\<^bold>\<and>" 51) where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>c w. (\<phi> c w)\<and>(\<psi> c w)"
abbreviation por::"m\<Rightarrow>m\<Rightarrow>m" (infixr"\<^bold>\<or>" 50) where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>c w. (\<phi> c w)\<or>(\<psi> c w)"
abbreviation pimp::"m\<Rightarrow>m\<Rightarrow>m" (infix"\<^bold>\<rightarrow>" 49) where "\<phi>\<^bold>\<rightarrow>\<psi> \<equiv> \<lambda>c w. (\<phi> c w)\<longrightarrow>(\<psi> c w)"
abbreviation pequ::"m\<Rightarrow>m\<Rightarrow>m" (infix"\<^bold>\<leftrightarrow>" 48) where "\<phi>\<^bold>\<leftrightarrow>\<psi> \<equiv> \<lambda>c w. (\<phi> c w)\<longleftrightarrow>(\<psi> c w)"
abbreviation pnot::"m\<Rightarrow>m" ("\<^bold>\<not>_" [52]53) where "\<^bold>\<not>\<phi> \<equiv> \<lambda>c w. \<not>(\<phi> c w)"

subsubsection \<open>Modal Operators\<close>
abbreviation cjboxa :: "m\<Rightarrow>m" ("\<^bold>\<box>\<^sub>a_" [52]53) where "\<^bold>\<box>\<^sub>a\<phi> \<equiv> \<lambda>c w. \<forall>v. (av w) v \<longrightarrow> (\<phi> c v)"
abbreviation cjdiaa :: "m\<Rightarrow>m" ("\<^bold>\<diamond>\<^sub>a_" [52]53) where "\<^bold>\<diamond>\<^sub>a\<phi> \<equiv> \<lambda>c w. \<exists>v. (av w) v \<and> (\<phi> c v)"
abbreviation cjboxp :: "m\<Rightarrow>m" ("\<^bold>\<box>\<^sub>p_" [52]53) where "\<^bold>\<box>\<^sub>p\<phi> \<equiv> \<lambda>c w. \<forall>v. (pv w) v \<longrightarrow> (\<phi> c v)"
abbreviation cjdiap :: "m\<Rightarrow>m" ("\<^bold>\<diamond>\<^sub>p_" [52]53) where "\<^bold>\<diamond>\<^sub>p\<phi> \<equiv> \<lambda>c w. \<exists>v. (pv w) v \<and> (\<phi> c v)"
abbreviation cjtaut :: "m" ("\<^bold>\<top>") where "\<^bold>\<top> \<equiv> \<lambda>c w. True"
abbreviation cjcontr :: "m" ("\<^bold>\<bottom>") where "\<^bold>\<bottom> \<equiv> \<lambda>c w. False"

subsubsection \<open>Deontic Operators\<close>
abbreviation cjod :: "m\<Rightarrow>m\<Rightarrow>m" ("\<^bold>O\<langle>_|_\<rangle>"54) where "\<^bold>O\<langle>\<phi>|\<sigma>\<rangle> \<equiv> \<lambda>c w. ob (\<sigma> c) (\<phi> c)"
abbreviation cjoa :: "m\<Rightarrow>m" ("\<^bold>O\<^sub>a_" [53]54) where "\<^bold>O\<^sub>a\<phi> \<equiv> \<lambda>c w. (ob (av w)) (\<phi> c) \<and> (\<exists>x. (av w) x \<and> \<not>(\<phi> c x))"
abbreviation cjop :: "m\<Rightarrow>m" ("\<^bold>O\<^sub>i_" [53]54) where "\<^bold>O\<^sub>i\<phi> \<equiv> \<lambda>c w. (ob (pv w)) (\<phi> c) \<and> (\<exists>x. (pv w) x \<and> \<not>(\<phi> c x))"

subsubsection \<open>Logical Validity (Classical)\<close>
abbreviation modvalidctx :: "m\<Rightarrow>c\<Rightarrow>bool" ("\<lfloor>_\<rfloor>\<^sup>M") where "\<lfloor>\<phi>\<rfloor>\<^sup>M \<equiv> \<lambda>c. \<forall>w. \<phi> c w" \<comment> \<open> context-dependent modal validity \<close>
abbreviation modvalid :: "m\<Rightarrow>bool" ("\<lfloor>_\<rfloor>") where "\<lfloor>\<phi>\<rfloor> \<equiv> \<forall>c. \<lfloor>\<phi>\<rfloor>\<^sup>M c" \<comment> \<open> general modal validity (modally valid in each context) \<close>

(*
If we introduce the alternative definition of logical validity below (from Kaplan's LD) instead of the previous one,
we can prove valid most of the following theorems excepting only CJ_7 and CJ_8 and the necessitation rule.

consts World::"c\<Rightarrow>w"  \<comment> \<open> function retrieving the world corresponding to context c (Kaplanian contexts are world-centered) \<close>
abbreviation ldtruectx::"m\<Rightarrow>c\<Rightarrow>bool" ("\<lfloor>_\<rfloor>\<^sub>_") where "\<lfloor>\<phi>\<rfloor>\<^sub>c \<equiv> \<phi> c (World c)" \<comment> \<open>  truth in the given context \<close>
abbreviation ldvalid::"m\<Rightarrow>bool" ("\<lfloor>_\<rfloor>") where "\<lfloor>\<phi>\<rfloor> \<equiv> \<forall>c. \<lfloor>\<phi>\<rfloor>\<^sub>c"    \<comment> \<open>  LD validity (true in every context) \<close>
*)

subsection \<open>Verifying the Embedding\<close>

subsubsection \<open>Avoiding Modal Collapse\<close>
lemma "\<lfloor>P \<^bold>\<rightarrow> \<^bold>O\<^sub>aP\<rfloor>" nitpick oops \<comment> \<open> (actual) deontic modal collapse is countersatisfiable \<close>
lemma "\<lfloor>P \<^bold>\<rightarrow> \<^bold>O\<^sub>iP\<rfloor>" nitpick oops \<comment> \<open> (ideal) deontic modal collapse is countersatisfiable \<close>
lemma "\<lfloor>P \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>aP\<rfloor>" nitpick oops \<comment> \<open> alethic modal collapse is countersatisfiable (implies all other necessity operators) \<close>

subsubsection \<open>Necessitation Rule\<close>
lemma NecDDLa: "\<lfloor>A\<rfloor> \<Longrightarrow> \<lfloor>\<^bold>\<box>\<^sub>aA\<rfloor>"  by simp (* Valid only using classical (not LD) validity*)
lemma NecDDLp:  "\<lfloor>A\<rfloor> \<Longrightarrow> \<lfloor>\<^bold>\<box>\<^sub>pA\<rfloor>" by simp (* Valid only using classical (not LD) validity*)

subsubsection \<open>Lemmas for Semantic Conditions\<close> (* extracted from Benzmüller et al. paper @{cite "BenzmuellerDDL"}*)

abbreviation mboxS5 :: "m\<Rightarrow>m" ("\<^bold>\<box>\<^sup>S\<^sup>5_" [52]53) where "\<^bold>\<box>\<^sup>S\<^sup>5\<phi> \<equiv> \<lambda>c w. \<forall>v. \<phi> c v"
abbreviation mdiaS5 :: "m\<Rightarrow>m" ("\<^bold>\<diamond>\<^sup>S\<^sup>5_" [52]53) where "\<^bold>\<diamond>\<^sup>S\<^sup>5\<phi> \<equiv> \<lambda>c w. \<exists>v. \<phi> c v"

lemma C_2: "\<lfloor>\<^bold>O\<langle>A | B\<rangle> \<^bold>\<rightarrow> \<^bold>\<diamond>\<^sup>S\<^sup>5(B \<^bold>\<and> A)\<rfloor>" by (simp add: sem_5ab)
lemma C_3:  "\<lfloor>((\<^bold>\<diamond>\<^sup>S\<^sup>5(A \<^bold>\<and> B \<^bold>\<and> C)) \<^bold>\<and> \<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>O\<langle>C|A\<rangle>) \<^bold>\<rightarrow> \<^bold>O\<langle>(B \<^bold>\<and> C)| A\<rangle>\<rfloor>" by (simp add: sem_5c)
lemma C_4: "\<lfloor>(\<^bold>\<box>\<^sup>S\<^sup>5(A \<^bold>\<rightarrow> B) \<^bold>\<and> \<^bold>\<diamond>\<^sup>S\<^sup>5(A \<^bold>\<and> C) \<^bold>\<and> \<^bold>O\<langle>C|B\<rangle>) \<^bold>\<rightarrow> \<^bold>O\<langle>C|A\<rangle>\<rfloor>" using sem_5e by blast
lemma C_5: "\<lfloor>\<^bold>\<box>\<^sup>S\<^sup>5(A \<^bold>\<leftrightarrow> B) \<^bold>\<rightarrow> (\<^bold>O\<langle>C|A\<rangle> \<^bold>\<rightarrow> \<^bold>O\<langle>C|B\<rangle>)\<rfloor>" using C_2 sem_5e by blast
lemma C_6: "\<lfloor>\<^bold>\<box>\<^sup>S\<^sup>5(C \<^bold>\<rightarrow> (A \<^bold>\<leftrightarrow> B)) \<^bold>\<rightarrow> (\<^bold>O\<langle>A|C\<rangle> \<^bold>\<leftrightarrow> \<^bold>O\<langle>B|C\<rangle>)\<rfloor>" by (metis sem_5b)
lemma C_7: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^sup>S\<^sup>5\<^bold>O\<langle>B|A\<rangle>\<rfloor>" by blast
lemma C_8: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>O\<langle>A \<^bold>\<rightarrow> B| \<^bold>\<top>\<rangle>\<rfloor>" using sem_5bd4 by presburger

subsubsection \<open>Verifying Axiomatic Characterisation\<close>

text\<open>\noindent{The following theorems have been taken from the original Carmo and Jones' paper (@{cite "CJDDL"} p.293ff).}\<close>

lemma CJ_3: "\<lfloor>\<^bold>\<box>\<^sub>pA \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>aA\<rfloor>" by (simp add: sem_4a)
lemma CJ_4: "\<lfloor>\<^bold>\<not>\<^bold>O\<langle>\<^bold>\<bottom>|A\<rangle>\<rfloor>" by (simp add: sem_5a)

lemma CJ_5: "\<lfloor>(\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>O\<langle>C|A\<rangle>) \<^bold>\<rightarrow> \<^bold>O\<langle>B\<^bold>\<and>C|A\<rangle>\<rfloor>" nitpick oops \<comment> \<open> countermodel found \<close>
lemma CJ_5_minus: "\<lfloor>\<^bold>\<diamond>\<^sup>S\<^sup>5(A \<^bold>\<and> B \<^bold>\<and> C) \<^bold>\<and> (\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>O\<langle>C|A\<rangle>) \<^bold>\<rightarrow> \<^bold>O\<langle>B\<^bold>\<and>C|A\<rangle>\<rfloor>" by (simp add: sem_5c)

lemma CJ_6: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>O\<langle>B|A\<^bold>\<and>B\<rangle>\<rfloor>" by (smt C_2 C_4)
lemma CJ_7: "\<lfloor>A \<^bold>\<leftrightarrow> B\<rfloor> \<longrightarrow> \<lfloor>\<^bold>O\<langle>C|A\<rangle> \<^bold>\<leftrightarrow> \<^bold>O\<langle>C|B\<rangle>\<rfloor>" using sem_5ab sem_5e by blast (* Valid only using classical (not Kaplan's indexical) validity*)
lemma CJ_8: "\<lfloor>C \<^bold>\<rightarrow> (A \<^bold>\<leftrightarrow> B)\<rfloor> \<longrightarrow> \<lfloor>\<^bold>O\<langle>A|C\<rangle> \<^bold>\<leftrightarrow> \<^bold>O\<langle>B|C\<rangle>\<rfloor>" using C_6 by simp (* Valid only using classical (not Kaplan's indexical) validity*)

lemma CJ_9a: "\<lfloor>\<^bold>\<diamond>\<^sub>p\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>p\<^bold>O\<langle>B|A\<rangle>\<rfloor>" by simp
lemma CJ_9p: "\<lfloor>\<^bold>\<diamond>\<^sub>a\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>a\<^bold>O\<langle>B|A\<rangle>\<rfloor>" by simp
lemma CJ_9_var_a: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>a\<^bold>O\<langle>B|A\<rangle>\<rfloor>" by simp
lemma CJ_9_var_b: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^sub>p\<^bold>O\<langle>B|A\<rangle>\<rfloor>" by simp

lemma CJ_11a: "\<lfloor>(\<^bold>O\<^sub>aA \<^bold>\<and> \<^bold>O\<^sub>aB) \<^bold>\<rightarrow> \<^bold>O\<^sub>a(A \<^bold>\<and> B)\<rfloor>" nitpick oops \<comment> \<open>  countermodel found \<close>
lemma CJ_11a_var: "\<lfloor>\<^bold>\<diamond>\<^sub>a(A \<^bold>\<and> B) \<^bold>\<and> (\<^bold>O\<^sub>aA \<^bold>\<and> \<^bold>O\<^sub>aB) \<^bold>\<rightarrow> \<^bold>O\<^sub>a(A \<^bold>\<and> B)\<rfloor>" using sem_5c by auto

lemma CJ_11p: "\<lfloor>(\<^bold>O\<^sub>iA \<^bold>\<and> \<^bold>O\<^sub>iB) \<^bold>\<rightarrow> \<^bold>O\<^sub>i(A \<^bold>\<and> B)\<rfloor>" nitpick oops \<comment> \<open>  countermodel found \<close>
lemma CJ_11p_var: "\<lfloor>\<^bold>\<diamond>\<^sub>p(A \<^bold>\<and> B) \<^bold>\<and> (\<^bold>O\<^sub>iA \<^bold>\<and> \<^bold>O\<^sub>iB) \<^bold>\<rightarrow> \<^bold>O\<^sub>i(A \<^bold>\<and> B)\<rfloor>" using sem_5c by auto

lemma CJ_12a: "\<lfloor>\<^bold>\<box>\<^sub>aA \<^bold>\<rightarrow> (\<^bold>\<not>\<^bold>O\<^sub>aA \<^bold>\<and> \<^bold>\<not>\<^bold>O\<^sub>a(\<^bold>\<not>A))\<rfloor>" using sem_5ab by blast (*using C_2 by blast *)
lemma CJ_12p: "\<lfloor>\<^bold>\<box>\<^sub>pA \<^bold>\<rightarrow> (\<^bold>\<not>\<^bold>O\<^sub>iA \<^bold>\<and> \<^bold>\<not>\<^bold>O\<^sub>i(\<^bold>\<not>A))\<rfloor>" using sem_5ab by blast (*using C_2 by blast*)

lemma CJ_13a: "\<lfloor>\<^bold>\<box>\<^sub>a(A \<^bold>\<leftrightarrow> B) \<^bold>\<rightarrow> (\<^bold>O\<^sub>aA \<^bold>\<leftrightarrow> \<^bold>O\<^sub>aB)\<rfloor>" using sem_5b by metis (*using C_6 by blast *)
lemma CJ_13p: "\<lfloor>\<^bold>\<box>\<^sub>p(A \<^bold>\<leftrightarrow> B) \<^bold>\<rightarrow> (\<^bold>O\<^sub>iA \<^bold>\<leftrightarrow> \<^bold>O\<^sub>iB)\<rfloor>" using sem_5b by metis (*using C_6 by blast *)

lemma CJ_O_O: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<rightarrow> \<^bold>O\<langle>A \<^bold>\<rightarrow> B|\<^bold>\<top>\<rangle>\<rfloor>" using sem_5bd4 by presburger

text\<open>\noindent{An ideal obligation which is actually possible both to fulfill and to violate entails an actual obligation (@{cite "CJDDL"} p.319).}\<close>
lemma CJ_Oi_Oa: "\<lfloor>(\<^bold>O\<^sub>iA \<^bold>\<and> \<^bold>\<diamond>\<^sub>aA \<^bold>\<and> \<^bold>\<diamond>\<^sub>a(\<^bold>\<not>A)) \<^bold>\<rightarrow> \<^bold>O\<^sub>aA\<rfloor>" using sem_5e sem_4a by blast

text\<open>\noindent{Bridge relations between conditional obligations and actual/ideal obligations:}\<close>
lemma CJ_14a: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>\<box>\<^sub>aA \<^bold>\<and> \<^bold>\<diamond>\<^sub>aB \<^bold>\<and> \<^bold>\<diamond>\<^sub>a\<^bold>\<not>B \<^bold>\<rightarrow> \<^bold>O\<^sub>aB\<rfloor>" using sem_5e by blast
lemma CJ_14p: "\<lfloor>\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>\<box>\<^sub>pA \<^bold>\<and> \<^bold>\<diamond>\<^sub>pB \<^bold>\<and> \<^bold>\<diamond>\<^sub>p\<^bold>\<not>B \<^bold>\<rightarrow> \<^bold>O\<^sub>iB\<rfloor>" using sem_5e by blast

lemma CJ_15a: "\<lfloor>(\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>\<diamond>\<^sub>a(A \<^bold>\<and> B) \<^bold>\<and> \<^bold>\<diamond>\<^sub>a(A \<^bold>\<and> \<^bold>\<not>B)) \<^bold>\<rightarrow>  \<^bold>O\<^sub>a(A \<^bold>\<rightarrow> B)\<rfloor>" using CJ_O_O sem_5e by fastforce (*using CJ_O_O CJ_14a by blast*)
lemma CJ_15p: "\<lfloor>(\<^bold>O\<langle>B|A\<rangle> \<^bold>\<and> \<^bold>\<diamond>\<^sub>p(A \<^bold>\<and> B) \<^bold>\<and> \<^bold>\<diamond>\<^sub>p(A \<^bold>\<and> \<^bold>\<not>B)) \<^bold>\<rightarrow>  \<^bold>O\<^sub>i(A \<^bold>\<rightarrow> B)\<rfloor>" using CJ_O_O sem_5e by fastforce (*using CJ_O_O CJ_14p by blast*)

(*<*)
end
(*>*)


(*:maxLineLen=78:*)

theory Synopsis
  imports Main Base
begin

chapter \<open>Synopsis\<close>

section \<open>Notepad\<close>

text \<open>
  An Isar proof body serves as mathematical notepad to compose logical
  content, consisting of types, terms, facts.
\<close>

subsection \<open>Types and terms\<close>

notepad
begin
  txt \<open>Locally fixed entities:\<close>
  fix x   \<comment> \<open>local constant, without any type information yet\<close>
  fix x :: 'a  \<comment> \<open>variant with explicit type-constraint for subsequent use\<close>

  fix a b
  assume "a = b"  \<comment> \<open>type assignment at first occurrence in concrete term\<close>

  txt \<open>Definitions (non-polymorphic):\<close>
  define x :: 'a where "x = t"

  txt \<open>Abbreviations (polymorphic):\<close>
  let ?f = "\<lambda>x. x"
  term "?f ?f"

  txt \<open>Notation:\<close>
  write x  ("***")
end

subsection \<open>Facts\<close>

text \<open>
  A fact is a simultaneous list of theorems.
\<close>

subsubsection \<open>Producing facts\<close>

notepad
begin

  txt \<open>Via assumption (``lambda''):\<close>
  assume a: A

  txt \<open>Via proof (``let''):\<close>
  have b: B \<proof>

  txt \<open>Via abbreviation (``let''):\<close>
  note c = a b

end

subsubsection \<open>Referencing facts\<close>

notepad
begin
  txt \<open>Via explicit name:\<close>
  assume a: A
  note a

  txt \<open>Via implicit name:\<close>
  assume A
  note this

  txt \<open>Via literal proposition (unification with results from the proof text):\<close>
  assume A
  note \<open>A\<close>

  assume "\<And>x. B x"
  note \<open>B a\<close>
  note \<open>B b\<close>
end

subsubsection \<open>Manipulating facts\<close>

notepad
begin
  txt \<open>Instantiation:\<close>
  assume a: "\<And>x. B x"
  note a
  note a [of b]
  note a [where x = b]

  txt \<open>Backchaining:\<close>
  assume 1: A
  assume 2: "A \<Longrightarrow> C"
  note 2 [OF 1]
  note 1 [THEN 2]

  txt \<open>Symmetric results:\<close>
  assume "x = y"
  note this [symmetric]

  assume "x \<noteq> y"
  note this [symmetric]

  txt \<open>Adhoc-simplification (take care!):\<close>
  assume "P ([] @ xs)"
  note this [simplified]
end

subsubsection \<open>Projections\<close>

text \<open>
  Isar facts consist of multiple theorems.  There is notation to project
  interval ranges.
\<close>

notepad
begin
  assume stuff: A B C D
  note stuff(1)
  note stuff(2-3)
  note stuff(2-)
end

subsubsection \<open>Naming conventions\<close>

text \<open>
  \<^item> Lower-case identifiers are usually preferred.

  \<^item> Facts can be named after the main term within the proposition.

  \<^item> Facts should \<^emph>\<open>not\<close> be named after the command that
  introduced them (@{command "assume"}, @{command "have"}).  This is
  misleading and hard to maintain.

  \<^item> Natural numbers can be used as ``meaningless'' names (more
  appropriate than \<open>a1\<close>, \<open>a2\<close> etc.)

  \<^item> Symbolic identifiers are supported (e.g. \<open>*\<close>, \<open>**\<close>, \<open>***\<close>).
\<close>

subsection \<open>Block structure\<close>

text \<open>
  The formal notepad is block structured.  The fact produced by the last
  entry of a block is exported into the outer context.
\<close>

notepad
begin
  {
    have a: A \<proof>
    have b: B \<proof>
    note a b
  }
  note this
  note \<open>A\<close>
  note \<open>B\<close>
end

text \<open>Explicit blocks as well as implicit blocks of nested goal
  statements (e.g.\ @{command have}) automatically introduce one extra
  pair of parentheses in reserve.  The @{command next} command allows
  to ``jump'' between these sub-blocks.\<close>

notepad
begin

  {
    have a: A \<proof>
  next
    have b: B
    proof -
      show B \<proof>
    next
      have c: C \<proof>
    next
      have d: D \<proof>
    qed
  }

  txt \<open>Alternative version with explicit parentheses everywhere:\<close>

  {
    {
      have a: A \<proof>
    }
    {
      have b: B
      proof -
        {
          show B \<proof>
        }
        {
          have c: C \<proof>
        }
        {
          have d: D \<proof>
        }
      qed
    }
  }

end

section \<open>Calculational reasoning \label{sec:calculations-synopsis}\<close>

text \<open>
  For example, see \<^file>\<open>~~/src/HOL/Isar_Examples/Group.thy\<close>.
\<close>

subsection \<open>Special names in Isar proofs\<close>

text \<open>
  \<^item> term \<open>?thesis\<close> --- the main conclusion of the
  innermost pending claim

  \<^item> term \<open>\<dots>\<close> --- the argument of the last explicitly
  stated result (for infix application this is the right-hand side)

  \<^item> fact \<open>this\<close> --- the last result produced in the text
\<close>

notepad
begin
  have "x = y"
  proof -
    term ?thesis
    show ?thesis \<proof>
    term ?thesis  \<comment> \<open>static!\<close>
  qed
  term "\<dots>"
  thm this
end

text \<open>Calculational reasoning maintains the special fact called
  ``\<open>calculation\<close>'' in the background.  Certain language
  elements combine primary \<open>this\<close> with secondary \<open>calculation\<close>.\<close>

subsection \<open>Transitive chains\<close>

text \<open>The Idea is to combine \<open>this\<close> and \<open>calculation\<close>
  via typical \<open>trans\<close> rules (see also @{command
  print_trans_rules}):\<close>

thm trans
thm less_trans
thm less_le_trans

notepad
begin
  txt \<open>Plain bottom-up calculation:\<close>
  have "a = b" \<proof>
  also
  have "b = c" \<proof>
  also
  have "c = d" \<proof>
  finally
  have "a = d" .

  txt \<open>Variant using the \<open>\<dots>\<close> abbreviation:\<close>
  have "a = b" \<proof>
  also
  have "\<dots> = c" \<proof>
  also
  have "\<dots> = d" \<proof>
  finally
  have "a = d" .

  txt \<open>Top-down version with explicit claim at the head:\<close>
  have "a = d"
  proof -
    have "a = b" \<proof>
    also
    have "\<dots> = c" \<proof>
    also
    have "\<dots> = d" \<proof>
    finally
    show ?thesis .
  qed
next
  txt \<open>Mixed inequalities (require suitable base type):\<close>
  fix a b c d :: nat

  have "a < b" \<proof>
  also
  have "b \<le> c" \<proof>
  also
  have "c = d" \<proof>
  finally
  have "a < d" .
end

subsubsection \<open>Notes\<close>

text \<open>
  \<^item> The notion of \<open>trans\<close> rule is very general due to the
  flexibility of Isabelle/Pure rule composition.

  \<^item> User applications may declare their own rules, with some care
  about the operational details of higher-order unification.
\<close>

subsection \<open>Degenerate calculations\<close>

text \<open>The Idea is to append \<open>this\<close> to \<open>calculation\<close>, without rule composition.
  This is occasionally useful to avoid naming intermediate facts.\<close>

notepad
begin
  txt \<open>A vacuous proof:\<close>
  have A \<proof>
  moreover
  have B \<proof>
  moreover
  have C \<proof>
  ultimately
  have A and B and C .
next
  txt \<open>Slightly more content (trivial bigstep reasoning):\<close>
  have A \<proof>
  moreover
  have B \<proof>
  moreover
  have C \<proof>
  ultimately
  have "A \<and> B \<and> C" by blast
end

text \<open>Note that For multi-branch case splitting, it is better to use @{command
  consider}.\<close>

section \<open>Induction\<close>

subsection \<open>Induction as Natural Deduction\<close>

text \<open>In principle, induction is just a special case of Natural
  Deduction (see also \secref{sec:natural-deduction-synopsis}).  For
  example:\<close>

thm nat.induct
print_statement nat.induct

notepad
begin
  fix n :: nat
  have "P n"
  proof (rule nat.induct)  \<comment> \<open>fragile rule application!\<close>
    show "P 0" \<proof>
  next
    fix n :: nat
    assume "P n"
    show "P (Suc n)" \<proof>
  qed
end

text \<open>
  In practice, much more proof infrastructure is required.

  The proof method @{method induct} provides:

  \<^item> implicit rule selection and robust instantiation

  \<^item> context elements via symbolic case names

  \<^item> support for rule-structured induction statements, with local
  parameters, premises, etc.
\<close>

notepad
begin
  fix n :: nat
  have "P n"
  proof (induct n)
    case 0
    show ?case \<proof>
  next
    case (Suc n)
    from Suc.hyps show ?case \<proof>
  qed
end

subsubsection \<open>Example\<close>

text \<open>
  The subsequent example combines the following proof patterns:

  \<^item> outermost induction (over the datatype structure of natural
  numbers), to decompose the proof problem in top-down manner

  \<^item> calculational reasoning (\secref{sec:calculations-synopsis})
  to compose the result in each case

  \<^item> solving local claims within the calculation by simplification
\<close>

lemma
  fixes n :: nat
  shows "(\<Sum>i=0..n. i) = n * (n + 1) div 2"
proof (induct n)
  case 0
  have "(\<Sum>i=0..0. i) = (0::nat)" by simp
  also have "\<dots> = 0 * (0 + 1) div 2" by simp
  finally show ?case .
next
  case (Suc n)
  have "(\<Sum>i=0..Suc n. i) = (\<Sum>i=0..n. i) + (n + 1)" by simp
  also have "\<dots> = n * (n + 1) div 2 + (n + 1)" by (simp add: Suc.hyps)
  also have "\<dots> = (n * (n + 1) + 2 * (n + 1)) div 2" by simp
  also have "\<dots> = (Suc n * (Suc n + 1)) div 2" by simp
  finally show ?case .
qed

text \<open>This demonstrates how induction proofs can be done without
  having to consider the raw Natural Deduction structure.\<close>

subsection \<open>Induction with local parameters and premises\<close>

text \<open>Idea: Pure rule statements are passed through the induction
  rule.  This achieves convenient proof patterns, thanks to some
  internal trickery in the @{method induct} method.

  Important: Using compact HOL formulae with \<open>\<forall>/\<longrightarrow>\<close> is a
  well-known anti-pattern! It would produce useless formal noise.
\<close>

notepad
begin
  fix n :: nat
  fix P :: "nat \<Rightarrow> bool"
  fix Q :: "'a \<Rightarrow> nat \<Rightarrow> bool"

  have "P n"
  proof (induct n)
    case 0
    show "P 0" \<proof>
  next
    case (Suc n)
    from \<open>P n\<close> show "P (Suc n)" \<proof>
  qed

  have "A n \<Longrightarrow> P n"
  proof (induct n)
    case 0
    from \<open>A 0\<close> show "P 0" \<proof>
  next
    case (Suc n)
    from \<open>A n \<Longrightarrow> P n\<close>
      and \<open>A (Suc n)\<close> show "P (Suc n)" \<proof>
  qed

  have "\<And>x. Q x n"
  proof (induct n)
    case 0
    show "Q x 0" \<proof>
  next
    case (Suc n)
    from \<open>\<And>x. Q x n\<close> show "Q x (Suc n)" \<proof>
    txt \<open>Local quantification admits arbitrary instances:\<close>
    note \<open>Q a n\<close> and \<open>Q b n\<close>
  qed
end

subsection \<open>Implicit induction context\<close>

text \<open>The @{method induct} method can isolate local parameters and
  premises directly from the given statement.  This is convenient in
  practical applications, but requires some understanding of what is
  going on internally (as explained above).\<close>

notepad
begin
  fix n :: nat
  fix Q :: "'a \<Rightarrow> nat \<Rightarrow> bool"

  fix x :: 'a
  assume "A x n"
  then have "Q x n"
  proof (induct n arbitrary: x)
    case 0
    from \<open>A x 0\<close> show "Q x 0" \<proof>
  next
    case (Suc n)
    from \<open>\<And>x. A x n \<Longrightarrow> Q x n\<close>  \<comment> \<open>arbitrary instances can be produced here\<close>
      and \<open>A x (Suc n)\<close> show "Q x (Suc n)" \<proof>
  qed
end

subsection \<open>Advanced induction with term definitions\<close>

text \<open>Induction over subexpressions of a certain shape are delicate
  to formalize.  The Isar @{method induct} method provides
  infrastructure for this.

  Idea: sub-expressions of the problem are turned into a defined
  induction variable; often accompanied with fixing of auxiliary
  parameters in the original expression.\<close>

notepad
begin
  fix a :: "'a \<Rightarrow> nat"
  fix A :: "nat \<Rightarrow> bool"

  assume "A (a x)"
  then have "P (a x)"
  proof (induct "a x" arbitrary: x)
    case 0
    note prem = \<open>A (a x)\<close>
      and defn = \<open>0 = a x\<close>
    show "P (a x)" \<proof>
  next
    case (Suc n)
    note hyp = \<open>\<And>x. n = a x \<Longrightarrow> A (a x) \<Longrightarrow> P (a x)\<close>
      and prem = \<open>A (a x)\<close>
      and defn = \<open>Suc n = a x\<close>
    show "P (a x)" \<proof>
  qed
end

section \<open>Natural Deduction \label{sec:natural-deduction-synopsis}\<close>

subsection \<open>Rule statements\<close>

text \<open>
  Isabelle/Pure ``theorems'' are always natural deduction rules,
  which sometimes happen to consist of a conclusion only.

  The framework connectives \<open>\<And>\<close> and \<open>\<Longrightarrow>\<close> indicate the
  rule structure declaratively.  For example:\<close>

thm conjI
thm impI
thm nat.induct

text \<open>
  The object-logic is embedded into the Pure framework via an implicit
  derivability judgment \<^term>\<open>Trueprop :: bool \<Rightarrow> prop\<close>.

  Thus any HOL formulae appears atomic to the Pure framework, while
  the rule structure outlines the corresponding proof pattern.

  This can be made explicit as follows:
\<close>

notepad
begin
  write Trueprop  ("Tr")

  thm conjI
  thm impI
  thm nat.induct
end

text \<open>
  Isar provides first-class notation for rule statements as follows.
\<close>

print_statement conjI
print_statement impI
print_statement nat.induct

subsubsection \<open>Examples\<close>

text \<open>
  Introductions and eliminations of some standard connectives of
  the object-logic can be written as rule statements as follows.  (The
  proof ``@{command "by"}~@{method blast}'' serves as sanity check.)
\<close>

lemma "(P \<Longrightarrow> False) \<Longrightarrow> \<not> P" by blast
lemma "\<not> P \<Longrightarrow> P \<Longrightarrow> Q" by blast

lemma "P \<Longrightarrow> Q \<Longrightarrow> P \<and> Q" by blast
lemma "P \<and> Q \<Longrightarrow> (P \<Longrightarrow> Q \<Longrightarrow> R) \<Longrightarrow> R" by blast

lemma "P \<Longrightarrow> P \<or> Q" by blast
lemma "Q \<Longrightarrow> P \<or> Q" by blast
lemma "P \<or> Q \<Longrightarrow> (P \<Longrightarrow> R) \<Longrightarrow> (Q \<Longrightarrow> R) \<Longrightarrow> R" by blast

lemma "(\<And>x. P x) \<Longrightarrow> (\<forall>x. P x)" by blast
lemma "(\<forall>x. P x) \<Longrightarrow> P x" by blast

lemma "P x \<Longrightarrow> (\<exists>x. P x)" by blast
lemma "(\<exists>x. P x) \<Longrightarrow> (\<And>x. P x \<Longrightarrow> R) \<Longrightarrow> R" by blast

lemma "x \<in> A \<Longrightarrow> x \<in> B \<Longrightarrow> x \<in> A \<inter> B" by blast
lemma "x \<in> A \<inter> B \<Longrightarrow> (x \<in> A \<Longrightarrow> x \<in> B \<Longrightarrow> R) \<Longrightarrow> R" by blast

lemma "x \<in> A \<Longrightarrow> x \<in> A \<union> B" by blast
lemma "x \<in> B \<Longrightarrow> x \<in> A \<union> B" by blast
lemma "x \<in> A \<union> B \<Longrightarrow> (x \<in> A \<Longrightarrow> R) \<Longrightarrow> (x \<in> B \<Longrightarrow> R) \<Longrightarrow> R" by blast

subsection \<open>Isar context elements\<close>

text \<open>We derive some results out of the blue, using Isar context
  elements and some explicit blocks.  This illustrates their meaning
  wrt.\ Pure connectives, without goal states getting in the way.\<close>

notepad
begin
  {
    fix x
    have "B x" \<proof>
  }
  have "\<And>x. B x" by fact

next

  {
    assume A
    have B \<proof>
  }
  have "A \<Longrightarrow> B" by fact

next

  {
    define x where "x = t"
    have "B x" \<proof>
  }
  have "B t" by fact

next

  {
    obtain x :: 'a where "B x" \<proof>
    have C \<proof>
  }
  have C by fact

end

subsection \<open>Pure rule composition\<close>

text \<open>
  The Pure framework provides means for:

  \<^item> backward-chaining of rules by @{inference resolution}

  \<^item> closing of branches by @{inference assumption}

  Both principles involve higher-order unification of \<open>\<lambda>\<close>-terms
  modulo \<open>\<alpha>\<beta>\<eta>\<close>-equivalence (cf.\ Huet and Miller).
\<close>

notepad
begin
  assume a: A and b: B
  thm conjI
  thm conjI [of A B]  \<comment> \<open>instantiation\<close>
  thm conjI [of A B, OF a b]  \<comment> \<open>instantiation and composition\<close>
  thm conjI [OF a b]  \<comment> \<open>composition via unification (trivial)\<close>
  thm conjI [OF \<open>A\<close> \<open>B\<close>]

  thm conjI [OF disjI1]
end

text \<open>Note: Low-level rule composition is tedious and leads to
  unreadable~/ unmaintainable expressions in the text.\<close>

subsection \<open>Structured backward reasoning\<close>

text \<open>Idea: Canonical proof decomposition via @{command fix}~/
  @{command assume}~/ @{command show}, where the body produces a
  natural deduction rule to refine some goal.\<close>

notepad
begin
  fix A B :: "'a \<Rightarrow> bool"

  have "\<And>x. A x \<Longrightarrow> B x"
  proof -
    fix x
    assume "A x"
    show "B x" \<proof>
  qed

  have "\<And>x. A x \<Longrightarrow> B x"
  proof -
    {
      fix x
      assume "A x"
      show "B x" \<proof>
    } \<comment> \<open>implicit block structure made explicit\<close>
    note \<open>\<And>x. A x \<Longrightarrow> B x\<close>
      \<comment> \<open>side exit for the resulting rule\<close>
  qed
end

subsection \<open>Structured rule application\<close>

text \<open>
  Idea: Previous facts and new claims are composed with a rule from
  the context (or background library).
\<close>

notepad
begin
  assume r\<^sub>1: "A \<Longrightarrow> B \<Longrightarrow> C"  \<comment> \<open>simple rule (Horn clause)\<close>

  have A \<proof>  \<comment> \<open>prefix of facts via outer sub-proof\<close>
  then have C
  proof (rule r\<^sub>1)
    show B \<proof>  \<comment> \<open>remaining rule premises via inner sub-proof\<close>
  qed

  have C
  proof (rule r\<^sub>1)
    show A \<proof>
    show B \<proof>
  qed

  have A and B \<proof>
  then have C
  proof (rule r\<^sub>1)
  qed

  have A and B \<proof>
  then have C by (rule r\<^sub>1)

next

  assume r\<^sub>2: "A \<Longrightarrow> (\<And>x. B\<^sub>1 x \<Longrightarrow> B\<^sub>2 x) \<Longrightarrow> C"  \<comment> \<open>nested rule\<close>

  have A \<proof>
  then have C
  proof (rule r\<^sub>2)
    fix x
    assume "B\<^sub>1 x"
    show "B\<^sub>2 x" \<proof>
  qed

  txt \<open>The compound rule premise \<^prop>\<open>\<And>x. B\<^sub>1 x \<Longrightarrow> B\<^sub>2 x\<close> is better
    addressed via @{command fix}~/ @{command assume}~/ @{command show}
    in the nested proof body.\<close>
end

subsection \<open>Example: predicate logic\<close>

text \<open>
  Using the above principles, standard introduction and elimination proofs
  of predicate logic connectives of HOL work as follows.
\<close>

notepad
begin
  have "A \<longrightarrow> B" and A \<proof>
  then have B ..

  have A \<proof>
  then have "A \<or> B" ..

  have B \<proof>
  then have "A \<or> B" ..

  have "A \<or> B" \<proof>
  then have C
  proof
    assume A
    then show C \<proof>
  next
    assume B
    then show C \<proof>
  qed

  have A and B \<proof>
  then have "A \<and> B" ..

  have "A \<and> B" \<proof>
  then have A ..

  have "A \<and> B" \<proof>
  then have B ..

  have False \<proof>
  then have A ..

  have True ..

  have "\<not> A"
  proof
    assume A
    then show False \<proof>
  qed

  have "\<not> A" and A \<proof>
  then have B ..

  have "\<forall>x. P x"
  proof
    fix x
    show "P x" \<proof>
  qed

  have "\<forall>x. P x" \<proof>
  then have "P a" ..

  have "\<exists>x. P x"
  proof
    show "P a" \<proof>
  qed

  have "\<exists>x. P x" \<proof>
  then have C
  proof
    fix a
    assume "P a"
    show C \<proof>
  qed

  txt \<open>Less awkward version using @{command obtain}:\<close>
  have "\<exists>x. P x" \<proof>
  then obtain a where "P a" ..
end

text \<open>Further variations to illustrate Isar sub-proofs involving
  @{command show}:\<close>

notepad
begin
  have "A \<and> B"
  proof  \<comment> \<open>two strictly isolated subproofs\<close>
    show A \<proof>
  next
    show B \<proof>
  qed

  have "A \<and> B"
  proof  \<comment> \<open>one simultaneous sub-proof\<close>
    show A and B \<proof>
  qed

  have "A \<and> B"
  proof  \<comment> \<open>two subproofs in the same context\<close>
    show A \<proof>
    show B \<proof>
  qed

  have "A \<and> B"
  proof  \<comment> \<open>swapped order\<close>
    show B \<proof>
    show A \<proof>
  qed

  have "A \<and> B"
  proof  \<comment> \<open>sequential subproofs\<close>
    show A \<proof>
    show B using \<open>A\<close> \<proof>
  qed
end

subsubsection \<open>Example: set-theoretic operators\<close>

text \<open>There is nothing special about logical connectives (\<open>\<and>\<close>, \<open>\<or>\<close>, \<open>\<forall>\<close>, \<open>\<exists>\<close> etc.).  Operators from
  set-theory or lattice-theory work analogously.  It is only a matter
  of rule declarations in the library; rules can be also specified
  explicitly.
\<close>

notepad
begin
  have "x \<in> A" and "x \<in> B" \<proof>
  then have "x \<in> A \<inter> B" ..

  have "x \<in> A" \<proof>
  then have "x \<in> A \<union> B" ..

  have "x \<in> B" \<proof>
  then have "x \<in> A \<union> B" ..

  have "x \<in> A \<union> B" \<proof>
  then have C
  proof
    assume "x \<in> A"
    then show C \<proof>
  next
    assume "x \<in> B"
    then show C \<proof>
  qed

next
  have "x \<in> \<Inter>A"
  proof
    fix a
    assume "a \<in> A"
    show "x \<in> a" \<proof>
  qed

  have "x \<in> \<Inter>A" \<proof>
  then have "x \<in> a"
  proof
    show "a \<in> A" \<proof>
  qed

  have "a \<in> A" and "x \<in> a" \<proof>
  then have "x \<in> \<Union>A" ..

  have "x \<in> \<Union>A" \<proof>
  then obtain a where "a \<in> A" and "x \<in> a" ..
end

section \<open>Generalized elimination and cases\<close>

subsection \<open>General elimination rules\<close>

text \<open>
  The general format of elimination rules is illustrated by the
  following typical representatives:
\<close>

thm exE     \<comment> \<open>local parameter\<close>
thm conjE   \<comment> \<open>local premises\<close>
thm disjE   \<comment> \<open>split into cases\<close>

text \<open>
  Combining these characteristics leads to the following general scheme
  for elimination rules with cases:

  \<^item> prefix of assumptions (or ``major premises'')

  \<^item> one or more cases that enable to establish the main conclusion
  in an augmented context
\<close>

notepad
begin
  assume r:
    "A\<^sub>1 \<Longrightarrow> A\<^sub>2 \<Longrightarrow>  \<comment> \<open>assumptions\<close>
      (\<And>x y. B\<^sub>1 x y \<Longrightarrow> C\<^sub>1 x y \<Longrightarrow> R) \<Longrightarrow>  \<comment> \<open>case 1\<close>
      (\<And>x y. B\<^sub>2 x y \<Longrightarrow> C\<^sub>2 x y \<Longrightarrow> R) \<Longrightarrow>  \<comment> \<open>case 2\<close>
      R  \<comment> \<open>main conclusion\<close>"

  have A\<^sub>1 and A\<^sub>2 \<proof>
  then have R
  proof (rule r)
    fix x y
    assume "B\<^sub>1 x y" and "C\<^sub>1 x y"
    show ?thesis \<proof>
  next
    fix x y
    assume "B\<^sub>2 x y" and "C\<^sub>2 x y"
    show ?thesis \<proof>
  qed
end

text \<open>Here \<open>?thesis\<close> is used to refer to the unchanged goal
  statement.\<close>

subsection \<open>Rules with cases\<close>

text \<open>
  Applying an elimination rule to some goal, leaves that unchanged
  but allows to augment the context in the sub-proof of each case.

  Isar provides some infrastructure to support this:

  \<^item> native language elements to state eliminations

  \<^item> symbolic case names

  \<^item> method @{method cases} to recover this structure in a
  sub-proof
\<close>

print_statement exE
print_statement conjE
print_statement disjE

lemma
  assumes A\<^sub>1 and A\<^sub>2  \<comment> \<open>assumptions\<close>
  obtains
    (case\<^sub>1)  x y where "B\<^sub>1 x y" and "C\<^sub>1 x y"
  | (case\<^sub>2)  x y where "B\<^sub>2 x y" and "C\<^sub>2 x y"
  \<proof>

subsubsection \<open>Example\<close>

lemma tertium_non_datur:
  obtains
    (T)  A
  | (F)  "\<not> A"
  by blast

notepad
begin
  fix x y :: 'a
  have C
  proof (cases "x = y" rule: tertium_non_datur)
    case T
    from \<open>x = y\<close> show ?thesis \<proof>
  next
    case F
    from \<open>x \<noteq> y\<close> show ?thesis \<proof>
  qed
end

subsubsection \<open>Example\<close>

text \<open>
  Isabelle/HOL specification mechanisms (datatype, inductive, etc.)
  provide suitable derived cases rules.
\<close>

datatype foo = Foo | Bar foo

notepad
begin
  fix x :: foo
  have C
  proof (cases x)
    case Foo
    from \<open>x = Foo\<close> show ?thesis \<proof>
  next
    case (Bar a)
    from \<open>x = Bar a\<close> show ?thesis \<proof>
  qed
end

subsection \<open>Elimination statements and case-splitting\<close>

text \<open>
  The @{command consider} states rules for generalized elimination and case
  splitting. This is like a toplevel statement \<^theory_text>\<open>theorem obtains\<close> used within
  a proof body; or like a multi-branch \<^theory_text>\<open>obtain\<close> without activation of the
  local context elements yet.

  The proof method @{method cases} is able to use such rules with
  forward-chaining (e.g.\ via \<^theory_text>\<open>then\<close>). This leads to the subsequent pattern
  for case-splitting in a particular situation within a proof.
\<close>

notepad
begin
  consider (a) A | (b) B | (c) C
    \<proof>  \<comment> \<open>typically \<^theory_text>\<open>by auto\<close>, \<^theory_text>\<open>by blast\<close> etc.\<close>
  then have something
  proof cases
    case a
    then show ?thesis \<proof>
  next
    case b
    then show ?thesis \<proof>
  next
    case c
    then show ?thesis \<proof>
  qed
end

subsection \<open>Obtaining local contexts\<close>

text \<open>A single ``case'' branch may be inlined into Isar proof text
  via @{command obtain}.  This proves \<^prop>\<open>(\<And>x. B x \<Longrightarrow> thesis) \<Longrightarrow>
  thesis\<close> on the spot, and augments the context afterwards.\<close>

notepad
begin
  fix B :: "'a \<Rightarrow> bool"

  obtain x where "B x" \<proof>
  note \<open>B x\<close>

  txt \<open>Conclusions from this context may not mention \<^term>\<open>x\<close> again!\<close>
  {
    obtain x where "B x" \<proof>
    from \<open>B x\<close> have C \<proof>
  }
  note \<open>C\<close>
end

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics written for Isabelle/Isar.

    Copyright (C) 2013 Daniel de la Concepcion

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *)

section \<open>Topology 9\<close>

theory Topology_ZF_9
imports Topology_ZF_2 Group_ZF_2 Topology_ZF_7 Topology_ZF_8
begin

subsection\<open>Group of homeomorphisms\<close>
text\<open>This theory file deals with the fact the set homeomorphisms of a topological space into itself
 forms a group.\<close>

text\<open>First, we define the set of homeomorphisms.\<close>

definition
  "HomeoG(T) \<equiv> {f:\<Union>T\<rightarrow>\<Union>T. IsAhomeomorphism(T,T,f)}"

text\<open>The homeomorphisms are closed by composition.\<close>

lemma (in topology0) homeo_composition:
  assumes "f\<in>HomeoG(T)""g\<in>HomeoG(T)"
  shows "Composition(\<Union>T)`\<langle>f, g\<rangle>\<in>HomeoG(T)"
proof-
  from assms have fun:"f\<in>\<Union>T\<rightarrow>\<Union>T""g\<in>\<Union>T\<rightarrow>\<Union>T" and homeo:"IsAhomeomorphism(T,T,f)""IsAhomeomorphism(T,T,g)" unfolding HomeoG_def
    by auto
  from fun have "f O g\<in>\<Union>T\<rightarrow>\<Union>T" using comp_fun by auto moreover
  from homeo have bij:"f\<in>bij(\<Union>T,\<Union>T)""g\<in>bij(\<Union>T,\<Union>T)" and cont:"IsContinuous(T,T,f)""IsContinuous(T,T,g)" and contconv:
    "IsContinuous(T,T,converse(f))""IsContinuous(T,T,converse(g))" unfolding IsAhomeomorphism_def by auto
  from bij have "f O g\<in>bij(\<Union>T,\<Union>T)" using comp_bij by auto moreover
  from cont have "IsContinuous(T,T,f O g)" using comp_cont by auto moreover
  have "converse(f O g)=converse(g) O converse(f)" using converse_comp by auto
  with contconv have "IsContinuous(T,T,converse(f O g))" using comp_cont by auto ultimately
  have "f O g\<in>HomeoG(T)" unfolding HomeoG_def IsAhomeomorphism_def by auto
  then show ?thesis using func_ZF_5_L2 fun by auto
qed

text\<open>The identity function is a homeomorphism.\<close>

lemma (in topology0) homeo_id:
  shows "id(\<Union>T)\<in>HomeoG(T)"
proof-
  have "converse(id(\<Union>T)) O id(\<Union>T)=id(\<Union>T)" using left_comp_inverse id_bij by auto
  then have "converse(id(\<Union>T))=id(\<Union>T)" using right_comp_id by auto
  then show ?thesis unfolding HomeoG_def IsAhomeomorphism_def using id_cont id_type id_bij
    by auto
qed

text\<open>The homeomorphisms form a monoid and its neutral element is the identity.\<close>

theorem (in topology0) homeo_submonoid:
  shows "IsAmonoid(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))"
  "TheNeutralElement(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))=id(\<Union>T)"
proof-
  have cl:"HomeoG(T) {is closed under} Composition(\<Union>T)" unfolding IsOpClosed_def using homeo_composition by auto
  moreover have sub:"HomeoG(T)\<subseteq>\<Union>T\<rightarrow>\<Union>T" unfolding HomeoG_def by auto moreover
  have ne:"TheNeutralElement(\<Union>T\<rightarrow>\<Union>T, Composition(\<Union>T))\<in>HomeoG(T)" using homeo_id Group_ZF_2_5_L2(2) by auto
  ultimately show "IsAmonoid(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))" using Group_ZF_2_5_L2(1)
    monoid0.group0_1_T1 unfolding monoid0_def by force
  from cl sub ne have "TheNeutralElement(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))=TheNeutralElement(\<Union>T\<rightarrow>\<Union>T, Composition(\<Union>T))"
    using Group_ZF_2_5_L2(1) group0_1_L6 by blast moreover
  have "id(\<Union>T)=TheNeutralElement(\<Union>T\<rightarrow>\<Union>T, Composition(\<Union>T))" using Group_ZF_2_5_L2(2) by auto
  ultimately show "TheNeutralElement(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))=id(\<Union>T)" by auto
qed

text\<open>The homeomorphisms form a group, with the composition.\<close>

theorem(in topology0) homeo_group:
  shows "IsAgroup(HomeoG(T),restrict(Composition(\<Union>T),HomeoG(T)\<times>HomeoG(T)))"
proof-
  {
    fix x assume AS:"x\<in>HomeoG(T)"
    then have surj:"x\<in>surj(\<Union>T,\<Union>T)" and bij:"x\<in>bij(\<Union>T,\<Union>T)" unfolding HomeoG_def IsAhomeomorphism_def bij_def by auto
    from bij have "converse(x)\<in>bij(\<Union>T,\<Union>T)" using bij_converse_bij by auto
    with bij have conx_fun:"converse(x)\<in>\<Union>T\<rightarrow>\<Union>T""x\<in>\<Union>T\<rightarrow>\<Union>T" unfolding bij_def inj_def by auto
    from surj have id:"x O converse(x)=id(\<Union>T)" using right_comp_inverse by auto
    from conx_fun have "Composition(\<Union>T)`\<langle>x,converse(x)\<rangle>=x O converse(x)" using func_ZF_5_L2 by auto
    with id have "Composition(\<Union>T)`\<langle>x,converse(x)\<rangle>=id(\<Union>T)" by auto
    moreover have "converse(x)\<in>HomeoG(T)" unfolding HomeoG_def using conx_fun(1) homeo_inv AS unfolding HomeoG_def
      by auto
    ultimately have "\<exists>M\<in>HomeoG(T). Composition(\<Union>T)`\<langle>x,M\<rangle>=id(\<Union>T)" by auto
  }
  then have "\<forall>x\<in>HomeoG(T). \<exists>M\<in>HomeoG(T). Composition(\<Union>T)`\<langle>x,M\<rangle>=id(\<Union>T)" by auto
  then show ?thesis using homeo_submonoid definition_of_group by auto
qed

subsection\<open>Examples computed\<close>

text\<open>As a first example, we show that the group of homeomorphisms of the cocardinal
topology is the group of bijective functions.\<close>

theorem homeo_cocardinal:
  assumes "InfCard(Q)"
  shows "HomeoG(CoCardinal(X,Q))=bij(X,X)"
proof
  from assms have n:"Q\<noteq>0" unfolding InfCard_def by auto
  then show "HomeoG(CoCardinal(X,Q)) \<subseteq> bij(X, X)" unfolding HomeoG_def IsAhomeomorphism_def
    using union_cocardinal by auto
  {
    fix f assume a:"f\<in>bij(X,X)"
    then have "converse(f)\<in>bij(X,X)" using bij_converse_bij by auto
    then have cinj:"converse(f)\<in>inj(X,X)" unfolding bij_def by auto
    from a have fun:"f\<in>X\<rightarrow>X" unfolding bij_def inj_def by auto
    then have two:"two_top_spaces0((CoCardinal(X,Q)),(CoCardinal(X,Q)),f)" unfolding two_top_spaces0_def
      using union_cocardinal assms n CoCar_is_topology by auto
    {
      fix N assume "N{is closed in}(CoCardinal(X,Q))"
      then have N_def:"N=X \<or> (N\<in>Pow(X) \<and> N\<prec>Q)" using closed_sets_cocardinal n by auto
      then have "restrict(converse(f),N)\<in>bij(N,converse(f)``N)" using cinj restrict_bij by auto
      then have "N\<approx>f-``N" unfolding vimage_def eqpoll_def by auto
      then have "f-``N\<approx>N" using eqpoll_sym by auto
      with N_def have "N=X \<or> (f-``N\<prec>Q \<and> N\<in>Pow(X))" using eq_lesspoll_trans by auto
      with fun have "f-``N=X \<or> (f-``N\<prec>Q \<and> (f-``N)\<in>Pow(X))" using func1_1_L3 func1_1_L4 by auto
      then have "f-``N {is closed in}(CoCardinal(X,Q))" using closed_sets_cocardinal n by auto
    }
    then have "\<forall>N. N{is closed in}(CoCardinal(X,Q)) \<longrightarrow> f-``N {is closed in}(CoCardinal(X,Q))" by auto
    then have "IsContinuous((CoCardinal(X,Q)),(CoCardinal(X,Q)),f)" using two_top_spaces0.Top_ZF_2_1_L4
      two_top_spaces0.Top_ZF_2_1_L3 two_top_spaces0.Top_ZF_2_1_L2 two by auto
  }
  then have "\<forall>f\<in>bij(X,X). IsContinuous((CoCardinal(X,Q)),(CoCardinal(X,Q)),f)" by auto
  then have "\<forall>f\<in>bij(X,X). IsContinuous((CoCardinal(X,Q)),(CoCardinal(X,Q)),f) \<and> IsContinuous((CoCardinal(X,Q)),(CoCardinal(X,Q)),converse(f))"
    using bij_converse_bij by auto
  then have "\<forall>f\<in>bij(X,X). IsAhomeomorphism((CoCardinal(X,Q)),(CoCardinal(X,Q)),f)" unfolding IsAhomeomorphism_def
    using n union_cocardinal by auto
  then show "bij(X,X)\<subseteq>HomeoG((CoCardinal(X,Q)))" unfolding HomeoG_def bij_def inj_def using n union_cocardinal
    by auto
qed

text\<open>The group of homeomorphism of the excluded set is a direct product of the bijections on $X\setminus T$
  and the bijections on $X\cap T$.\<close>

theorem homeo_excluded:
  shows "HomeoG(ExcludedSet(X,T))={f\<in>bij(X,X). f``(X-T)=(X-T)}"
proof
  have sub1:"X-T\<subseteq>X" by auto
  {
    fix g assume "g\<in>HomeoG(ExcludedSet(X,T))"
    then have fun:"g:X\<rightarrow>X" and bij:"g\<in>bij(X,X)" and hom:"IsAhomeomorphism((ExcludedSet(X,T)),(ExcludedSet(X,T)),g)" unfolding HomeoG_def
      using union_excludedset unfolding IsAhomeomorphism_def by auto
    {
      assume A:"g``(X-T)=X" and B:"X\<inter>T\<noteq>0"
      have rfun:"restrict(g,X-T):X-T\<rightarrow>X" using fun restrict_fun sub1 by auto moreover
      from A fun have "{g`aa. aa\<in>X-T}=X" using func_imagedef sub1 by auto
      then have "\<forall>x\<in>X. x\<in>{g`aa. aa\<in>X-T}" by auto
      then have "\<forall>x\<in>X. \<exists>aa\<in>X-T. x=g`aa" by auto
      then have "\<forall>x\<in>X. \<exists>aa\<in>X-T. x=restrict(g,X-T)`aa" by auto
      with A have surj:"restrict(g,X-T)\<in>surj(X-T,X)" using rfun unfolding surj_def by auto
      from B obtain d where "d\<in>X""d\<in>T" by auto
      with bij have "g`d\<in>X" using apply_funtype unfolding bij_def inj_def by auto
      then obtain s where "restrict(g,X-T)`s=g`d""s\<in>X-T" using surj unfolding surj_def by blast
      then have "g`s=g`d" by auto
      with \<open>d\<in>X\<close>\<open>s\<in>X-T\<close> have "s=d" using bij unfolding bij_def inj_def by auto
      then have "False" using \<open>s\<in>X-T\<close> \<open>d\<in>T\<close> by auto
    }
    then have "g``(X-T)=X \<longrightarrow> X\<inter>T=0" by auto
    then have reg:"g``(X-T)=X \<longrightarrow> X-T=X" by auto
    then have "g``(X-T)=X \<longrightarrow> g``(X-T)=X-T" by auto
    then have "g``(X-T)=X \<longrightarrow> g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)}" using bij by auto moreover
    {
      fix gg
      assume A:"gg``(X-T)\<noteq>X" and hom2:"IsAhomeomorphism((ExcludedSet(X,T)),(ExcludedSet(X,T)),gg)"
      from hom2 have fun:"gg\<in>X\<rightarrow>X" and bij:"gg\<in>bij(X,X)" unfolding IsAhomeomorphism_def bij_def inj_def using union_excludedset by auto
      have sub:"X-T\<subseteq>\<Union>(ExcludedSet(X,T))" using union_excludedset by auto
      with hom2 have "gg``(Interior(X-T,(ExcludedSet(X,T))))=Interior(gg``(X-T),(ExcludedSet(X,T)))"
        using int_top_invariant by auto moreover
      from sub1 have "Interior(X-T,(ExcludedSet(X,T)))=X-T" using interior_set_excludedset by auto
      ultimately have "gg``(X-T)=Interior(gg``(X-T),(ExcludedSet(X,T)))" by auto moreover
      have ss:"gg``(X-T)\<subseteq>X" using fun func1_1_L6(2) by auto
      then have "Interior(gg``(X-T),(ExcludedSet(X,T))) = (gg``(X-T))-T" using interior_set_excludedset A
        by auto
      ultimately have eq:"gg``(X-T)=(gg``(X-T))-T" by auto
      {
        assume "(gg``(X-T))\<inter>T\<noteq>0"
        then obtain t where "t\<in>T" and im:"t\<in>gg``(X-T)" by blast
        then have "t\<notin>(gg``(X-T))-T" by auto
        then have "False" using eq im by auto
      }
      then have "(gg``(X-T))\<inter>T=0" by auto
      then have "gg``(X-T)\<subseteq>X-T" using ss by blast
    }
    then have "\<forall>gg. gg``(X-T)\<noteq>X \<and> IsAhomeomorphism(ExcludedSet(X,T),ExcludedSet(X,T),gg)\<longrightarrow> gg``(X-T)\<subseteq>X-T" by auto moreover
    from bij have conbij:"converse(g)\<in>bij(X,X)" using bij_converse_bij by auto
    then have confun:"converse(g)\<in>X\<rightarrow>X" unfolding bij_def inj_def by auto
    {
      assume A:"converse(g)``(X-T)=X" and B:"X\<inter>T\<noteq>0"
      have rfun:"restrict(converse(g),X-T):X-T\<rightarrow>X" using confun restrict_fun sub1 by auto moreover
      from A confun have "{converse(g)`aa. aa\<in>X-T}=X" using func_imagedef sub1 by auto
      then have "\<forall>x\<in>X. x\<in>{converse(g)`aa. aa\<in>X-T}" by auto
      then have "\<forall>x\<in>X. \<exists>aa\<in>X-T. x=converse(g)`aa" by auto
      then have "\<forall>x\<in>X. \<exists>aa\<in>X-T. x=restrict(converse(g),X-T)`aa" by auto
      with A have surj:"restrict(converse(g),X-T)\<in>surj(X-T,X)" using rfun unfolding surj_def by auto
      from B obtain d where "d\<in>X""d\<in>T" by auto
      with conbij have "converse(g)`d\<in>X" using apply_funtype unfolding bij_def inj_def by auto
      then obtain s where "restrict(converse(g),X-T)`s=converse(g)`d""s\<in>X-T" using surj unfolding surj_def by blast
      then have "converse(g)`s=converse(g)`d" by auto
      with \<open>d\<in>X\<close>\<open>s\<in>X-T\<close> have "s=d" using conbij unfolding bij_def inj_def by auto
      then have "False" using \<open>s\<in>X-T\<close> \<open>d\<in>T\<close> by auto
    }
    then have "converse(g)``(X-T)=X \<longrightarrow> X\<inter>T=0" by auto
    then have "converse(g)``(X-T)=X \<longrightarrow> X-T=X" by auto
    then have "converse(g)``(X-T)=X \<longrightarrow> g-``(X-T)=(X-T)" unfolding vimage_def by auto
    then have G:"converse(g)``(X-T)=X \<longrightarrow> g``(g-``(X-T))=g``(X-T)" by auto
    have GG:"g``(g-``(X-T))=(X-T)" using sub1 surj_image_vimage bij unfolding bij_def by auto
    with G have "converse(g)``(X-T)=X \<longrightarrow> g``(X-T)=X-T" by auto
    then have "converse(g)``(X-T)=X \<longrightarrow> g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)}" using bij by auto moreover
    from hom have "IsAhomeomorphism(ExcludedSet(X,T), ExcludedSet(X,T), converse(g))" using homeo_inv by auto
    moreover note hom ultimately have "g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)} \<or> (g``(X-T)\<subseteq>X-T \<and> converse(g)``(X-T)\<subseteq>X-T)"
      by force
    then have "g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)} \<or> (g``(X-T)\<subseteq>X-T \<and> g-``(X-T)\<subseteq>X-T)" unfolding vimage_def by auto moreover
    have "g-``(X-T)\<subseteq>X-T \<longrightarrow> g``(g-``(X-T))\<subseteq>g``(X-T)" using func1_1_L8 by auto
    with GG have "g-``(X-T)\<subseteq>X-T \<longrightarrow> (X-T)\<subseteq>g``(X-T)" by force
    ultimately have "g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)} \<or> (g``(X-T)\<subseteq>X-T \<and> (X-T)\<subseteq>g``(X-T))" by auto
    then have "g\<in>{f\<in>bij(X,X). f``(X-T)=(X-T)}" using bij by auto
  }
  then show "HomeoG(ExcludedSet(X,T))\<subseteq>{f\<in>bij(X,X). f``(X-T)=(X-T)}" by auto
  {
    fix g assume as:"g\<in>bij(X,X)""g``(X-T)=X-T"
    then have inj:"g\<in>inj(X,X)" and im:"g-``(g``(X-T))=g-``(X-T)" unfolding bij_def by auto
    from inj have "g-``(g``(X-T))=X-T" using inj_vimage_image sub1 by force
    with im have as_3:"g-``(X-T)=X-T" by auto
    {
      fix A
      assume "A\<in>(ExcludedSet(X,T))"
      then have "A=X\<or>A\<inter>T=0" "A\<subseteq>X" unfolding ExcludedSet_def by auto
      then have "A\<subseteq>X-T\<or>A=X" by auto moreover
      {
        assume "A=X"
        with as(1) have "g``A=X" using surj_range_image_domain unfolding bij_def by auto
      }
      moreover
      {
        assume "A\<subseteq>X-T"
        then have "g``A\<subseteq>g``(X-T)" using func1_1_L8 by auto
        then have "g``A\<subseteq>(X-T)" using as(2)  by auto
      }
      ultimately have "g``A\<subseteq>(X-T) \<or> g``A=X" by auto
      then have "g``A\<in>(ExcludedSet(X,T))" unfolding ExcludedSet_def by auto
    }
    then have "\<forall>A\<in>(ExcludedSet(X,T)). g``A\<in>(ExcludedSet(X,T))" by auto moreover
    {
      fix A assume "A\<in>(ExcludedSet(X,T))"
      then have "A=X\<or>A\<inter>T=0" "A\<subseteq>X" unfolding ExcludedSet_def by auto
      then have "A\<subseteq>X-T\<or>A=X" by auto moreover
      {
        assume "A=X"
        with as(1) have "g-``A=X" using func1_1_L4 unfolding bij_def inj_def by auto
      }
      moreover
      {
        assume "A\<subseteq>X-T"
        then have "g-``A\<subseteq>g-``(X-T)" using func1_1_L8 by auto
        then have "g-``A\<subseteq>(X-T)" using as_3 by auto
      }
      ultimately have "g-``A\<subseteq>(X-T) \<or> g-``A=X" by auto
      then have "g-``A\<in>(ExcludedSet(X,T))" unfolding ExcludedSet_def by auto
    }
    then have "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),g)" unfolding IsContinuous_def by auto moreover
    note as(1) ultimately have "IsAhomeomorphism(ExcludedSet(X,T),ExcludedSet(X,T),g)"
      using union_excludedset bij_cont_open_homeo by auto
    with as(1) have "g\<in>HomeoG(ExcludedSet(X,T))" unfolding bij_def inj_def HomeoG_def using union_excludedset by auto
  }
  then show "{f \<in> bij(X, X) . f `` (X - T) = X - T} \<subseteq> HomeoG(ExcludedSet(X,T))" by auto
qed

text\<open>We now give some lemmas that will help us compute \<open>HomeoG(IncludedSet(X,T))\<close>.\<close>

lemma cont_in_cont_ex:
  assumes "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),f)" "f:X\<rightarrow>X" "T\<subseteq>X"
  shows "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),f)"
proof-
  from assms(2,3) have two:"two_top_spaces0(IncludedSet(X,T),IncludedSet(X,T),f)" using union_includedset includedset_is_topology
    unfolding two_top_spaces0_def by auto
  {
    fix A assume "A\<in>(ExcludedSet(X,T))"
    then have "A\<inter>T=0 \<or> A=X""A\<subseteq>X" unfolding ExcludedSet_def by auto
    then have "A{is closed in}(IncludedSet(X,T))" using closed_sets_includedset assms by auto
    then have "f-``A{is closed in}(IncludedSet(X,T))" using two_top_spaces0.TopZF_2_1_L1 assms(1)
      two assms includedset_is_topology by auto
    then have "(f-``A)\<inter>T=0 \<or> f-``A=X""f-``A\<subseteq>X" using closed_sets_includedset assms(1,3) by auto
    then have "f-``A\<in>(ExcludedSet(X,T))" unfolding ExcludedSet_def by auto
  }
  then show "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),f)" unfolding IsContinuous_def by auto
qed

lemma cont_ex_cont_in:
  assumes "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),f)" "f:X\<rightarrow>X" "T\<subseteq>X"
  shows "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),f)"
proof-
  from assms(2) have two:"two_top_spaces0(ExcludedSet(X,T),ExcludedSet(X,T),f)" using union_excludedset excludedset_is_topology
    unfolding two_top_spaces0_def by auto
  {
    fix A assume "A\<in>(IncludedSet(X,T))"
    then have "T\<subseteq>A \<or> A=0""A\<subseteq>X" unfolding IncludedSet_def by auto
    then have "A{is closed in}(ExcludedSet(X,T))" using closed_sets_excludedset assms by auto
    then have "f-``A{is closed in}(ExcludedSet(X,T))" using two_top_spaces0.TopZF_2_1_L1 assms(1)
      two assms excludedset_is_topology by auto
    then have "T\<subseteq>(f-``A) \<or> f-``A=0""f-``A\<subseteq>X" using closed_sets_excludedset assms(1,3) by auto
    then have "f-``A\<in>(IncludedSet(X,T))" unfolding IncludedSet_def by auto
  }
  then show "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),f)" unfolding IsContinuous_def by auto
qed

text\<open>The previous lemmas imply that the group of homeomorphisms of the included set topology
is the same as the one of the excluded set topology.\<close>

lemma homeo_included:
  assumes "T\<subseteq>X"
  shows "HomeoG(IncludedSet(X,T))={f \<in> bij(X, X) . f `` (X - T) = X - T}"
proof-
  {
    fix f assume "f\<in>HomeoG(IncludedSet(X,T))"
    then have hom:"IsAhomeomorphism(IncludedSet(X,T),IncludedSet(X,T),f)" and fun:"f\<in>X\<rightarrow>X" and
      bij:"f\<in>bij(X,X)" unfolding HomeoG_def IsAhomeomorphism_def using union_includedset assms by auto
    then have cont:"IsContinuous(IncludedSet(X,T),IncludedSet(X,T),f)" unfolding IsAhomeomorphism_def by auto
    then have "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),f)" using cont_in_cont_ex fun assms by auto moreover
    {
      from hom have cont1:"IsContinuous(IncludedSet(X,T),IncludedSet(X,T),converse(f))" unfolding IsAhomeomorphism_def by auto moreover
      have "converse(f):X\<rightarrow>X" using bij_converse_bij bij unfolding bij_def inj_def by auto moreover
      note assms ultimately
      have "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),converse(f))" using cont_in_cont_ex assms by auto
    }
    then have "IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),converse(f))" by auto
    moreover note bij ultimately
    have "IsAhomeomorphism(ExcludedSet(X,T),ExcludedSet(X,T),f)" unfolding IsAhomeomorphism_def
      using union_excludedset by auto
    with fun have "f\<in>HomeoG(ExcludedSet(X,T))" unfolding HomeoG_def using union_excludedset by auto
  }
  then have "HomeoG(IncludedSet(X,T))\<subseteq>HomeoG(ExcludedSet(X,T))" by auto moreover
  {
    fix f assume "f\<in>HomeoG(ExcludedSet(X,T))"
    then have hom:"IsAhomeomorphism(ExcludedSet(X,T),ExcludedSet(X,T),f)" and fun:"f\<in>X\<rightarrow>X" and
      bij:"f\<in>bij(X,X)" unfolding HomeoG_def IsAhomeomorphism_def using union_excludedset assms by auto
    then have cont:"IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),f)" unfolding IsAhomeomorphism_def by auto
    then have "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),f)" using cont_ex_cont_in fun assms by auto moreover
    {
      from hom have cont1:"IsContinuous(ExcludedSet(X,T),ExcludedSet(X,T),converse(f))" unfolding IsAhomeomorphism_def by auto moreover
      have "converse(f):X\<rightarrow>X" using bij_converse_bij bij unfolding bij_def inj_def by auto moreover
      note assms ultimately
      have "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),converse(f))" using cont_ex_cont_in assms by auto
    }
    then have "IsContinuous(IncludedSet(X,T),IncludedSet(X,T),converse(f))" by auto
    moreover note bij ultimately
    have "IsAhomeomorphism(IncludedSet(X,T),IncludedSet(X,T),f)" unfolding IsAhomeomorphism_def
      using union_includedset assms by auto
    with fun have "f\<in>HomeoG(IncludedSet(X,T))" unfolding HomeoG_def using union_includedset assms by auto
  }
  then have "HomeoG(ExcludedSet(X,T))\<subseteq>HomeoG(IncludedSet(X,T))" by auto ultimately
  show ?thesis using homeo_excluded by auto
qed

text\<open>Finally, let's compute part of the group of homeomorphisms of an order topology.\<close>

lemma homeo_order:
  assumes "IsLinOrder(X,r)""\<exists>x y. x\<noteq>y\<and>x\<in>X\<and>y\<in>X"
  shows "ord_iso(X,r,X,r)\<subseteq>HomeoG(OrdTopology X r)"
proof
  fix f assume "f\<in>ord_iso(X,r,X,r)"
  then have bij:"f\<in>bij(X,X)" and ord:"\<forall>x\<in>X. \<forall>y\<in>X. \<langle>x, y\<rangle> \<in> r \<longleftrightarrow> \<langle>f ` x, f ` y\<rangle> \<in> r"
    unfolding ord_iso_def by auto
  have twoSpac:"two_top_spaces0(OrdTopology X r,OrdTopology X r,f)" unfolding two_top_spaces0_def
    using bij unfolding bij_def inj_def using union_ordtopology[OF assms] Ordtopology_is_a_topology(1)[OF assms(1)]
    by auto
  {
    fix c d assume A:"c\<in>X""d\<in>X"
    {
      fix x assume AA:"x\<in>X""x\<noteq>c""x\<noteq>d""\<langle>c,x\<rangle>\<in>r""\<langle>x,d\<rangle>\<in>r"
      then have "\<langle>f`c,f`x\<rangle>\<in>r""\<langle>f`x,f`d\<rangle>\<in>r" using A(2,1) ord by auto moreover
      {
        assume "f`x=f`c \<or> f`x=f`d"
        then have "x=c\<or>x=d" using bij unfolding bij_def inj_def using A(2,1) AA(1) by auto
        then have "False" using AA(2,3) by auto
      }
      then have "f`x\<noteq>f`c""f`x\<noteq>f`d" by auto moreover
      have "f`x\<in>X" using bij unfolding bij_def inj_def using apply_type AA(1) by auto
      ultimately have "f`x\<in>IntervalX(X,r,f`c,f`d)" unfolding IntervalX_def Interval_def by auto
    }
    then have "{f`x. x\<in>IntervalX(X,r,c,d)}\<subseteq>IntervalX(X,r,f`c,f`d)" unfolding IntervalX_def Interval_def by auto
    moreover
    {
      fix y assume "y\<in>IntervalX(X,r,f`c,f`d)"
      then have y:"y\<in>X""y\<noteq>f`c""y\<noteq>f`d""\<langle>f`c,y\<rangle>\<in>r""\<langle>y,f`d\<rangle>\<in>r" unfolding IntervalX_def Interval_def by auto
      then obtain s where s:"s\<in>X""y=f`s" using bij unfolding bij_def surj_def by auto
      {
        assume "s=c\<or>s=d"
        then have "f`s=f`c\<or>f`s=f`d" by auto
        then have "False" using s(2) y(2,3) by auto
      }
      then have "s\<noteq>c""s\<noteq>d" by auto moreover
      have "\<langle>c,s\<rangle>\<in>r""\<langle>s,d\<rangle>\<in>r" using y(4,5) s ord A(2,1) by auto moreover
      note s(1) ultimately have "s\<in>IntervalX(X,r,c,d)" unfolding IntervalX_def Interval_def by auto
      then have "y\<in>{f`x. x\<in>IntervalX(X,r,c,d)}" using s(2) by auto
    }
    ultimately have "{f`x. x\<in>IntervalX(X,r,c,d)}=IntervalX(X,r,f`c,f`d)" by auto moreover
    have "IntervalX(X,r,c,d)\<subseteq>X" unfolding IntervalX_def by auto moreover
    have "f:X\<rightarrow>X" using bij unfolding bij_def surj_def by auto ultimately
    have "f``IntervalX(X,r,c,d)=IntervalX(X,r,f`c,f`d)" using func_imagedef by auto
  }
  then have inter:"\<forall>c\<in>X. \<forall>d\<in>X. f``IntervalX(X,r,c,d)=IntervalX(X,r,f`c,f`d) \<and> f`c\<in>X \<and> f`d\<in>X" using bij
    unfolding bij_def inj_def by auto
  {
    fix c assume A:"c\<in>X"
    {
      fix x assume AA:"x\<in>X""x\<noteq>c""\<langle>c,x\<rangle>\<in>r"
      then have "\<langle>f`c,f`x\<rangle>\<in>r" using A ord by auto moreover
      {
        assume "f`x=f`c"
        then have "x=c" using bij unfolding bij_def inj_def using A AA(1) by auto
        then have "False" using AA(2) by auto
      }
      then have "f`x\<noteq>f`c" by auto moreover
      have "f`x\<in>X" using bij unfolding bij_def inj_def using apply_type AA(1) by auto
      ultimately have "f`x\<in>RightRayX(X,r,f`c)" unfolding RightRayX_def by auto
    }
    then have "{f`x. x\<in>RightRayX(X,r,c)}\<subseteq>RightRayX(X,r,f`c)" unfolding RightRayX_def by auto
    moreover
    {
      fix y assume "y\<in>RightRayX(X,r,f`c)"
      then have y:"y\<in>X""y\<noteq>f`c""\<langle>f`c,y\<rangle>\<in>r" unfolding RightRayX_def by auto
      then obtain s where s:"s\<in>X""y=f`s" using bij unfolding bij_def surj_def by auto
      {
        assume "s=c"
        then have "f`s=f`c" by auto
        then have "False" using s(2) y(2) by auto
      }
      then have "s\<noteq>c" by auto moreover
      have "\<langle>c,s\<rangle>\<in>r" using y(3) s ord A by auto moreover
      note s(1) ultimately have "s\<in>RightRayX(X,r,c)" unfolding RightRayX_def by auto
      then have "y\<in>{f`x. x\<in>RightRayX(X,r,c)}" using s(2) by auto
    }
    ultimately have "{f`x. x\<in>RightRayX(X,r,c)}=RightRayX(X,r,f`c)" by auto moreover
    have "RightRayX(X,r,c)\<subseteq>X" unfolding RightRayX_def by auto moreover
    have "f:X\<rightarrow>X" using bij unfolding bij_def surj_def by auto ultimately
    have "f``RightRayX(X,r,c)=RightRayX(X,r,f`c)" using func_imagedef by auto
  }
  then have rray:"\<forall>c\<in>X. f``RightRayX(X,r,c)=RightRayX(X,r,f`c) \<and> f`c\<in>X" using bij
    unfolding bij_def inj_def by auto
  {
    fix c assume A:"c\<in>X"
    {
      fix x assume AA:"x\<in>X""x\<noteq>c""\<langle>x,c\<rangle>\<in>r"
      then have "\<langle>f`x,f`c\<rangle>\<in>r" using A ord by auto moreover
      {
        assume "f`x=f`c"
        then have "x=c" using bij unfolding bij_def inj_def using A AA(1) by auto
        then have "False" using AA(2) by auto
      }
      then have "f`x\<noteq>f`c" by auto moreover
      have "f`x\<in>X" using bij unfolding bij_def inj_def using apply_type AA(1) by auto
      ultimately have "f`x\<in>LeftRayX(X,r,f`c)" unfolding LeftRayX_def by auto
    }
    then have "{f`x. x\<in>LeftRayX(X,r,c)}\<subseteq>LeftRayX(X,r,f`c)" unfolding LeftRayX_def by auto
    moreover
    {
      fix y assume "y\<in>LeftRayX(X,r,f`c)"
      then have y:"y\<in>X""y\<noteq>f`c""\<langle>y,f`c\<rangle>\<in>r" unfolding LeftRayX_def by auto
      then obtain s where s:"s\<in>X""y=f`s" using bij unfolding bij_def surj_def by auto
      {
        assume "s=c"
        then have "f`s=f`c" by auto
        then have "False" using s(2) y(2) by auto
      }
      then have "s\<noteq>c" by auto moreover
      have "\<langle>s,c\<rangle>\<in>r" using y(3) s ord A by auto moreover
      note s(1) ultimately have "s\<in>LeftRayX(X,r,c)" unfolding LeftRayX_def by auto
      then have "y\<in>{f`x. x\<in>LeftRayX(X,r,c)}" using s(2) by auto
    }
    ultimately have "{f`x. x\<in>LeftRayX(X,r,c)}=LeftRayX(X,r,f`c)" by auto moreover
    have "LeftRayX(X,r,c)\<subseteq>X" unfolding LeftRayX_def by auto moreover
    have "f:X\<rightarrow>X" using bij unfolding bij_def surj_def by auto ultimately
    have "f``LeftRayX(X,r,c)=LeftRayX(X,r,f`c)" using func_imagedef by auto
  }
  then have lray:"\<forall>c\<in>X. f``LeftRayX(X,r,c)=LeftRayX(X,r,f`c)\<and>f`c\<in>X" using bij
    unfolding bij_def inj_def by auto
  have r1:"\<forall>U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union>
    {RightRayX(X, r, b) . b \<in> X}. f``U\<in>({IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union>
    {RightRayX(X, r, b) . b \<in> X})" apply safe prefer 3 using rray apply blast prefer 2 using lray apply blast
    using inter apply auto
    proof-
     fix xa y assume "xa\<in>X""y\<in>X"
     then have "f`xa\<in>X""f`y\<in>X" using bij unfolding bij_def inj_def by auto
     then show "\<exists>x\<in>X. \<exists>ya\<in>X. IntervalX(X, r, f ` xa, f ` y) = IntervalX(X, r, x, ya)" by auto
    qed
  have r2:"{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union> {RightRayX(X, r, b) . b \<in> X}\<subseteq>(OrdTopology X r)"
    using base_sets_open[OF Ordtopology_is_a_topology(2)[OF assms(1)]] by blast
  {
    fix U assume "U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union> {RightRayX(X, r, b) . b \<in> X}"
    with r1 have "f``U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union> {RightRayX(X, r, b) . b \<in> X}"
      by auto
    with r2 have "f``U\<in>(OrdTopology X r)" by blast
  }
  then have "\<forall>U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union>
    {RightRayX(X, r, b) . b \<in> X}. f``U\<in>(OrdTopology X r)" by blast
  then have f_open:"\<forall>U\<in>(OrdTopology X r). f``U\<in>(OrdTopology X r)" using two_top_spaces0.base_image_open[OF twoSpac Ordtopology_is_a_topology(2)[OF assms(1)]]
    by auto
  {
    fix c d assume A:"c\<in>X""d\<in>X"
    then obtain cc dd where pre:"f`cc=c""f`dd=d""cc\<in>X""dd\<in>X" using bij unfolding bij_def surj_def by blast
    with inter have "f `` IntervalX(X, r, cc, dd) = IntervalX(X, r,  c,  d)" by auto
    then have "f-``(f``IntervalX(X, r, cc, dd)) = f-``(IntervalX(X, r,  c,  d))" by auto
    moreover
    have "IntervalX(X, r, cc, dd)\<subseteq>X" unfolding IntervalX_def by auto moreover
    have "f\<in>inj(X,X)" using bij unfolding bij_def by auto ultimately
    have "IntervalX(X, r, cc, dd)=f-``IntervalX(X, r,  c,  d)" using inj_vimage_image by auto
    moreover
    from pre(3,4) have "IntervalX(X, r, cc, dd)\<in>{IntervalX(X,r,e1,e2). \<langle>e1,e2\<rangle>\<in>X\<times>X}" by auto
    ultimately have "f-``IntervalX(X, r,  c,  d)\<in>(OrdTopology X r)" using
      base_sets_open[OF Ordtopology_is_a_topology(2)[OF assms(1)]] by auto
  }
  then have inter:"\<forall>c\<in>X. \<forall>d\<in>X. f-``IntervalX(X, r,  c,  d)\<in>(OrdTopology X r)" by auto
  {
    fix c assume A:"c\<in>X"
    then obtain cc where pre:"f`cc=c""cc\<in>X" using bij unfolding bij_def surj_def by blast
    with rray have "f `` RightRayX(X, r, cc) = RightRayX(X, r,  c)" by auto
    then have "f-``(f``RightRayX(X, r, cc)) = f-``(RightRayX(X, r,  c))" by auto
    moreover
    have "RightRayX(X, r, cc)\<subseteq>X" unfolding RightRayX_def by auto moreover
    have "f\<in>inj(X,X)" using bij unfolding bij_def by auto ultimately
    have "RightRayX(X, r, cc)=f-``RightRayX(X, r,  c)" using inj_vimage_image by auto
    moreover
    from pre(2) have "RightRayX(X, r, cc)\<in>{RightRayX(X,r,e2). e2\<in>X}" by auto
    ultimately have "f-``RightRayX(X, r,  c)\<in>(OrdTopology X r)" using
      base_sets_open[OF Ordtopology_is_a_topology(2)[OF assms(1)]] by auto
  }
  then have rray:"\<forall>c\<in>X. f-``RightRayX(X, r,  c)\<in>(OrdTopology X r)" by auto
  {
    fix c assume A:"c\<in>X"
    then obtain cc where pre:"f`cc=c""cc\<in>X" using bij unfolding bij_def surj_def by blast
    with lray have "f `` LeftRayX(X, r, cc) = LeftRayX(X, r,  c)" by auto
    then have "f-``(f``LeftRayX(X, r, cc)) = f-``(LeftRayX(X, r,  c))" by auto
    moreover
    have "LeftRayX(X, r, cc)\<subseteq>X" unfolding LeftRayX_def by auto moreover
    have "f\<in>inj(X,X)" using bij unfolding bij_def by auto ultimately
    have "LeftRayX(X, r, cc)=f-``LeftRayX(X, r,  c)" using inj_vimage_image by auto
    moreover
    from pre(2) have "LeftRayX(X, r, cc)\<in>{LeftRayX(X,r,e2). e2\<in>X}" by auto
    ultimately have "f-``LeftRayX(X, r,  c)\<in>(OrdTopology X r)" using
      base_sets_open[OF Ordtopology_is_a_topology(2)[OF assms(1)]] by auto
  }
  then have lray:"\<forall>c\<in>X. f-``LeftRayX(X, r,  c)\<in>(OrdTopology X r)" by auto
  {
    fix U assume "U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union> {RightRayX(X, r, b) . b \<in> X}"
    with lray inter rray have "f-``U\<in>(OrdTopology X r)" by auto
  }
  then have "\<forall>U\<in>{IntervalX(X, r, b, c) . \<langle>b,c\<rangle> \<in> X \<times> X} \<union> {LeftRayX(X, r, b) . b \<in> X} \<union> {RightRayX(X, r, b) . b \<in> X}.
    f-``U\<in>(OrdTopology X r)" by blast
  then have fcont:"IsContinuous(OrdTopology X r,OrdTopology X r,f)" using two_top_spaces0.Top_ZF_2_1_L5[OF twoSpac
    Ordtopology_is_a_topology(2)[OF assms(1)]] by auto
  from fcont f_open bij have "IsAhomeomorphism(OrdTopology X r,OrdTopology X r,f)" using bij_cont_open_homeo
    union_ordtopology[OF assms] by auto
  then show "f\<in>HomeoG(OrdTopology X r)" unfolding HomeoG_def using bij union_ordtopology[OF assms]
    unfolding bij_def inj_def by auto
qed

text\<open>This last example shows that order isomorphic sets give homeomorphic
topological spaces.\<close>

subsection\<open>Properties preserved by functions\<close>

text\<open>The continuous image of a connected space is connected.\<close>

theorem (in two_top_spaces0) cont_image_conn:
  assumes "IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2,f)" "f\<in>surj(X\<^sub>1,X\<^sub>2)" "\<tau>\<^sub>1{is connected}"
  shows "\<tau>\<^sub>2{is connected}"
proof-
  {
    fix U
    assume Uop:"U\<in>\<tau>\<^sub>2" and Ucl:"U{is closed in}\<tau>\<^sub>2"
    from Uop assms(1) have "f-``U\<in>\<tau>\<^sub>1" unfolding IsContinuous_def by auto moreover
    from Ucl assms(1) have  "f-``U{is closed in}\<tau>\<^sub>1" using TopZF_2_1_L1 by auto ultimately
    have disj:"f-``U=0 \<or> f-``U=\<Union>\<tau>\<^sub>1" using assms(3) unfolding IsConnected_def by auto moreover
    {
      assume as:"f-``U\<noteq>0"
      then have "U\<noteq>0" using func1_1_L13 by auto
      from as disj have "f-``U=\<Union>\<tau>\<^sub>1" by auto
      then have "f``(f-``U)=f``(\<Union>\<tau>\<^sub>1)" by auto moreover
      have "U\<subseteq>\<Union>\<tau>\<^sub>2" using Uop by blast ultimately
      have "U=f``(\<Union>\<tau>\<^sub>1)" using surj_image_vimage assms(2) Uop by force
      then have "\<Union>\<tau>\<^sub>2=U" using surj_range_image_domain assms(2) by auto
    }
    moreover
    {
      assume as:"U\<noteq>0"
      from Uop have s:"U\<subseteq>\<Union>\<tau>\<^sub>2" by auto
      with as obtain u where uU:"u\<in>U" by auto
      with s have "u\<in>\<Union>\<tau>\<^sub>2" by auto
      with assms(2) obtain w where "f`w=u""w\<in>\<Union>\<tau>\<^sub>1" unfolding surj_def X1_def X2_def by blast
      with uU have "w\<in>f-``U" using func1_1_L15 assms(2) unfolding surj_def by auto
      then have "f-``U\<noteq>0" by auto
    }
    ultimately have "U=0\<or>U=\<Union>\<tau>\<^sub>2" by auto
  }
  then show ?thesis unfolding IsConnected_def by auto
qed

text\<open>Every continuous function from a space which has some property \<open>P\<close>
  and a space which has the property \<open>anti(P)\<close>, given that
  this property is preserved by continuous functions, if follows that the range of the function
  is in the spectrum. Applied to connectedness, it follows that continuous functions from
  a connected space to a totally-disconnected one are constant.\<close>

corollary(in two_top_spaces0) cont_conn_tot_disc:
  assumes "IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2,f)" "\<tau>\<^sub>1{is connected}" "\<tau>\<^sub>2{is totally-disconnected}" "f:X\<^sub>1\<rightarrow>X\<^sub>2" "X\<^sub>1\<noteq>0"
  shows "\<exists>q\<in>X\<^sub>2. \<forall>w\<in>X\<^sub>1. f`(w)=q"
proof-
  from assms(4) have surj:"f\<in>surj(X\<^sub>1,range(f))" using fun_is_surj by auto
  have sub:"range(f)\<subseteq>X\<^sub>2" using func1_1_L5B assms(4) by auto
  from assms(1) have cont:"IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2{restricted to}range(f),f)" using restr_image_cont range_image_domain
    assms(4) by auto
  have union:"\<Union>(\<tau>\<^sub>2{restricted to}range(f))=range(f)" unfolding RestrictedTo_def using sub by auto
  then have "two_top_spaces0(\<tau>\<^sub>1,\<tau>\<^sub>2{restricted to}range(f),f)" unfolding two_top_spaces0_def
    using surj unfolding surj_def using tau1_is_top topology0.Top_1_L4 unfolding topology0_def using tau2_is_top
    by auto
  then have conn:"(\<tau>\<^sub>2{restricted to}range(f)){is connected}" using two_top_spaces0.cont_image_conn surj assms(2) cont
    union by auto
  then have "range(f){is in the spectrum of}IsConnected" using assms(3) sub unfolding IsTotDis_def antiProperty_def
    using union by auto
  then have "range(f)\<lesssim>1" using conn_spectrum by auto moreover
  from assms(5) have "f``X\<^sub>1\<noteq>0" using func1_1_L15A assms(4) by auto
  then have "range(f)\<noteq>0" using range_image_domain assms(4) by auto
  ultimately obtain q where uniq:"range(f)={q}" using lepoll_1_is_sing by blast
  {
    fix w assume "w\<in>X\<^sub>1"
    then have "f`w\<in>range(f)" using func1_1_L5A(2) assms(4) by auto
    with uniq have "f`w=q" by auto
  }
  then have "\<forall>w\<in>X\<^sub>1. f`w=q" by auto
  then show ?thesis using uniq sub by auto
qed

text\<open>The continuous image of a compact space is compact.\<close>

theorem (in two_top_spaces0) cont_image_com:
  assumes "IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2,f)" "f\<in>surj(X\<^sub>1,X\<^sub>2)" "X\<^sub>1{is compact of cardinal}K{in}\<tau>\<^sub>1"
  shows "X\<^sub>2{is compact of cardinal}K{in}\<tau>\<^sub>2"
proof-
  have "X\<^sub>2\<subseteq>\<Union>\<tau>\<^sub>2" by auto moreover
  {
    fix U assume as:"X\<^sub>2\<subseteq>\<Union>U" "U\<subseteq>\<tau>\<^sub>2"
    then have P:"{f-``V. V\<in>U}\<subseteq>\<tau>\<^sub>1" using assms(1) unfolding IsContinuous_def by auto
    from as(1) have "f-``X\<^sub>2 \<subseteq> f-``(\<Union>U)" by blast
    then have "f-``X\<^sub>2 \<subseteq> converse(f)``(\<Union>U)" unfolding vimage_def by auto moreover
    have "converse(f)``(\<Union>U)=(\<Union>V\<in>U. converse(f)``V)" using image_UN by force ultimately
    have "f-``X\<^sub>2 \<subseteq> (\<Union>V\<in>U. converse(f)``V)" by auto
    then have "f-``X\<^sub>2 \<subseteq> (\<Union>V\<in>U. f-``V)" unfolding vimage_def by auto
    then have "X\<^sub>1 \<subseteq> (\<Union>V\<in>U. f-``V)" using func1_1_L4 assms(2) unfolding surj_def by force
    then have "X\<^sub>1 \<subseteq> \<Union>{f-``V. V\<in>U}" by auto
    with P assms(3) have "\<exists>N\<in>Pow({f-``V. V\<in>U}). X\<^sub>1 \<subseteq> \<Union>N \<and> N\<prec>K" unfolding IsCompactOfCard_def by auto
    then obtain N where "N\<in>Pow({f-``V. V\<in>U})" "X\<^sub>1 \<subseteq> \<Union>N" "N\<prec>K" by auto
    then have fin:"N\<prec>K" and sub:"N\<subseteq>{f-``V. V\<in>U}" and cov:"X\<^sub>1 \<subseteq> \<Union>N" unfolding FinPow_def by auto
    from sub have "{f``R. R\<in>N}\<subseteq>{f``(f-``V). V\<in>U}" by auto moreover
    have "\<forall>V\<in>U. V\<subseteq>\<Union>\<tau>\<^sub>2" using as(2) by auto ultimately
    have "{f``R. R\<in>N}\<subseteq>U" using surj_image_vimage assms(2) by auto moreover
    let ?FN="{\<langle>R,f``R\<rangle>. R\<in>N}"
    have FN:"?FN:N\<rightarrow>{f``R. R\<in>N}" unfolding Pi_def function_def domain_def by auto
    {
      fix S assume "S\<in>{f``R. R\<in>N}"
      then obtain R where R_def:"R\<in>N""f``R=S" by auto
      then have "\<langle>R,f``R\<rangle>\<in>?FN" by auto
      then have "?FN`R=f``R" using FN apply_equality by auto
      then have "\<exists>R\<in>N. ?FN`R=S" using R_def by auto
    }
    then have surj:"?FN\<in>surj(N,{f``R. R\<in>N})" unfolding surj_def using FN by force
    from fin have N:"N\<lesssim>K" "Ord(K)" using assms(3) lesspoll_imp_lepoll unfolding IsCompactOfCard_def
      using Card_is_Ord by auto
    then have "{f``R. R\<in>N}\<lesssim>N" using surj_fun_inv_2 surj by auto
    then have "{f``R. R\<in>N}\<prec>K" using fin lesspoll_trans1 by blast
    moreover
    have "\<Union>{f``R. R\<in>N}=f``(\<Union>N)" using image_UN by auto
    then have "f``X\<^sub>1 \<subseteq> \<Union>{f``R. R\<in>N}" using cov by blast
    then have "X\<^sub>2 \<subseteq> \<Union>{f``R. R\<in>N}" using assms(2) surj_range_image_domain by auto
    ultimately have "\<exists>NN\<in>Pow(U). X\<^sub>2 \<subseteq> \<Union>NN \<and> NN\<prec>K" by auto
  }
  then have "\<forall>U\<in>Pow(\<tau>\<^sub>2). X\<^sub>2 \<subseteq> \<Union>U \<longrightarrow> (\<exists>NN\<in>Pow(U). X\<^sub>2 \<subseteq> \<Union>NN \<and> NN\<prec>K)" by auto
  ultimately show ?thesis using assms(3) unfolding IsCompactOfCard_def by auto
qed

text\<open>As it happends to connected spaces, a continuous function from a compact space
to an anti-compact space has finite range.\<close>

corollary (in two_top_spaces0) cont_comp_anti_comp:
  assumes "IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2,f)" "X\<^sub>1{is compact in}\<tau>\<^sub>1" "\<tau>\<^sub>2{is anti-compact}" "f:X\<^sub>1\<rightarrow>X\<^sub>2" "X\<^sub>1\<noteq>0"
  shows "Finite(range(f))" and "range(f)\<noteq>0"
proof-
  from assms(4) have surj:"f\<in>surj(X\<^sub>1,range(f))" using fun_is_surj by auto
  have sub:"range(f)\<subseteq>X\<^sub>2" using func1_1_L5B assms(4) by auto
  from assms(1) have cont:"IsContinuous(\<tau>\<^sub>1,\<tau>\<^sub>2{restricted to}range(f),f)" using restr_image_cont range_image_domain
    assms(4) by auto
  have union:"\<Union>(\<tau>\<^sub>2{restricted to}range(f))=range(f)" unfolding RestrictedTo_def using sub by auto
  then have "two_top_spaces0(\<tau>\<^sub>1,\<tau>\<^sub>2{restricted to}range(f),f)" unfolding two_top_spaces0_def
    using surj unfolding surj_def using tau1_is_top topology0.Top_1_L4 unfolding topology0_def using tau2_is_top
    by auto
  then have "range(f){is compact in}(\<tau>\<^sub>2{restricted to}range(f))" using surj two_top_spaces0.cont_image_com cont union
    assms(2) Compact_is_card_nat by force
  then have "range(f){is in the spectrum of}(\<lambda>T. (\<Union>T) {is compact in}T)" using assms(3) sub unfolding IsAntiComp_def antiProperty_def
    using union by auto
  then show "Finite(range(f))" using compact_spectrum by auto moreover
  from assms(5) have "f``X\<^sub>1\<noteq>0" using func1_1_L15A assms(4) by auto
  then show "range(f)\<noteq>0" using range_image_domain assms(4) by auto
qed

text\<open>As a consequence, it follows that quotient topological spaces of
compact (connected) spaces are compact (connected).\<close>

corollary(in topology0) compQuot:
  assumes "(\<Union>T){is compact in}T" "equiv(\<Union>T,r)"
  shows "(\<Union>T)//r{is compact in}({quotient by}r)"
proof-
  have surj:"{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T}\<in>surj(\<Union>T,(\<Union>T)//r)" using quotient_proj_surj by auto
  moreover have tot:"\<Union>({quotient by}r)=(\<Union>T)//r" using total_quo_equi assms(2) by auto
  ultimately have cont:"IsContinuous(T,{quotient by}r,{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T})" using quotient_func_cont
    EquivQuo_def assms(2) by auto
  from surj tot have "two_top_spaces0(T,{quotient by}r,{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T})" unfolding two_top_spaces0_def
    using topSpaceAssum equiv_quo_is_top assms(2) unfolding surj_def by auto
  with surj cont tot assms(1) show ?thesis using two_top_spaces0.cont_image_com Compact_is_card_nat by force
qed

corollary(in topology0) ConnQuot:
  assumes "T{is connected}" "equiv(\<Union>T,r)"
  shows "({quotient by}r){is connected}"
proof-
  have surj:"{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T}\<in>surj(\<Union>T,(\<Union>T)//r)" using quotient_proj_surj by auto
  moreover have tot:"\<Union>({quotient by}r)=(\<Union>T)//r" using total_quo_equi assms(2) by auto
  ultimately have cont:"IsContinuous(T,{quotient by}r,{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T})" using quotient_func_cont
    EquivQuo_def assms(2) by auto
  from surj tot have "two_top_spaces0(T,{quotient by}r,{\<langle>b,r``{b}\<rangle>. b\<in>\<Union>T})" unfolding two_top_spaces0_def
    using topSpaceAssum equiv_quo_is_top assms(2) unfolding surj_def by auto
  with surj cont tot assms(1) show ?thesis using two_top_spaces0.cont_image_conn by force
qed

end