(* Teorema de Knaster-Tarski *)

(*<*)
theory TeoremaKnasterTarski
  imports Main "HOL-Library.LaTeXsugar" "HOL-Library.OptionalSugar"
 "HOL-Library.Lattice_Syntax"
begin
(*>*)

section\<open>Teorema de Knaster Tarski \<close>

subsection \<open>Demostración en lenguaje natural \<close>

text \<open>El siguiente teorema, denominado teorema de Knaster-Tarski del
punto fijo, es un teorema de la teoría de retículos y lleva el nombre de
los matemáticos Bronislaw Knaster y Alfred Tarski.

Para la exposición y demostración del teorema es necesario definir una
 serie de  conceptos previos.

\begin{definicion}
Sea L un conjunto. Un orden parcial sobre L es una relación binaria
 $\leq$ sobre L, tal que $\forall x,y,z \in L$ se verifica:
\begin {enumerate}
\item $x \leq x$ (Propiedad reflexiva).
\item Si $x \leq y$ e $y \leq x$ entonces $x = y$ (Propiedad
 antisimétrica).
\item Si $x \leq y$ e $y \leq z$ entonces que $x \leq z$ (Propiedad
 transitiva).
\end{enumerate}
\end{definicion}

\begin{definicion}
Un conjunto $L$ con un relación de orden $(\leq)$ se denomina
 conjunto parcialmente ordenado y se denota $(L,\leq).$
\end{definicion}

\begin{definicion}
Dado un subconjunto $S$ de un conjunto $(L,\leq)$ parcialmente ordenado,
se define el supremo de $S$(sup $S$), si existe, al mínimo elemento de
 S que mayor o igual que cada elementos de S.
\end{definicion}

\begin{definicion}
Dado un subconjunto $S$ de un conjunto $(L,\leq)$ parcialmente ordenado,
se define el ínfimo de $S$(inf $S$), si existe, al máximo elemento de
 S que menor o igual que cada elementos de S.
\end{definicion}

\begin{definicion}
Sea $(L,\leq)$ un conjunto no vacío parcialmente ordenado. Se dirá que L es un
 retículo si:
\begin{enumerate}
\item Si $\forall a,b \in L$ existe sup$(\{a,b\}).$
\item Si $\forall a,b \in L$ existe inf$(\{a,b\}).$
\end{enumerate}
\end{definicion}

\begin{definicion}
Sea $(L,\leq)$ un conjunto parcialmente ordenado no vacío. Se dirá que $L$ es un
 retículo completo si $\forall S \subset L$ existe sup$(S)$ e inf$(S).$
\end{definicion}

\begin{ejemplo}
Ahora vamos a dar una serie de ejemplos de conjuntos que son
 retículos, retículos completos y algunos que no son retículos.

\begin{itemize}
\item Los subconjuntos de un conjunto dado con la relación de orden la
 inclusión es un retículo y el supremo está dado por la unión y el
 ínfimo por la intersección.
\item Los enteros no negativos, con la relación de orden la
 divisibilidad es un retículo con el ínfimo el mínimo común múltiplo y
 el supremo el máximo común divisor.
\item Los enteros no negativos, con la relación de orden la
 divisibilidad es un retículo completo siendo el ínfimo de este conjunto
el 1 ya que divide a cualquier número y siendo el supremo el 0 ya
 que es divisible por cualquier número.
\item Un ejemplo de un conjunto paricalmente ordenado, pero que no es un
retículo es el conjunto $\{ \emptyset, \{0\}, \{1\} \}$ con la relación
 de orden la inclusión. No es un retículo ya que el $\{0\}$ y el $\{1\}$
no tienen supremo.
\end{itemize}
\end{ejemplo}

\begin{definicion}
Una función $f: L \longrightarrow R$ entre dos conjuntos parcialmente
ordenados, \\ $(L,\leq)$ y $(R,\leq ')$ respectivamente. Se dirá que es
 monótona si conserva el orden, es decir, si $x \leq y
$ implica $f(x) \leq ' f(y)$.
\end{definicion}

\begin{definicion}
Sea  $(L,\leq)$ un conjunto parcialmente ordenado y  $f: L \longrightarrow L$.
Diremos que $x$ es un punto fijo de una función si y solo si $f(x) = x.$
\end{definicion}

El enunciado del teorema es el siguiente:

\begin{teorema}
Sea $L$ un retículo completo y $f: L \longrightarrow L$ una función
 monótona. Entonces $\exists a \in L$ punto fijo de $f.$
\end{teorema}

\begin{demostracion}
Hay que probar que $\exists a \in L$ tal que $f(a) = a.$ \\
Sea $H = \{ x \in L | f(x) \leq x \}.$ Como L, por hipótesis, es un
retículo completo tenemos que $\exists a = inf H,$ luego  como $a$ es una cota
 inferior se tiene que $\forall x \in H \, a \leq x.$ Como $f$ es una
 función monótona, $f(a) \leq f(x) \leq x \, \forall x \in H.$ Luego se
 obtiene que $f(a)$ es una cota inferior de $H,$ por ser cota inferior
 llegamos a que $f(a) \leq a.$ Ahora veamos que $f(a) \geq a$ y ya se
 tendría probado el teorema. En efecto, como $f$ es monótona, $f(f(a))
 \leq f(a).$ Esto implica que $f(a) \in H$ y como $a$ es cota inferior
 de $H$ entonces $a \leq f(a).$
\end{demostracion}
\<close>

subsection \<open> Especificación en Isabelle/HOL \<close>

text \<open>
Para la comprensión de la especificación vamos a notar una serie
de definiciones y notación que se encuentran en la teoría de retículos y retículos
completos importada en Isabelle,
\href{https://isabelle.in.tum.de/dist/library/HOL/HOL/Lattices.html}{Lattice.thy}
y \href{https://isabelle.in.tum.de/library/HOL/HOL-Lattice/CompleteLattice.html}
{LatticeComplete.thy} respectivamente.

La notación requerida para la comprensión de la especificación y
 demostración del teorema que viene importada de
\href{http://isabelle.in.tum.de/website-Isabelle2012/dist/library/HOL/
HOL-Library/Lattice_Syntax.html}{Lattice-Syntax.thy} es:

notation \\
  bot $(\bot)$ and \\
  top $(\top)$ and  \\
  inf  $($ infixl $\sqcap$ 70 $)$ and \\
  sup  $($ infixl $\sqcup$ 65 $)$ and \\
  Inf  $($ $\sqcap  -$ $[$900$]$ 900$)$ and \\
  Sup  $($ $\sqcup -$ $[$900$]$ 900$)$ \\

Tanto los retículos, como los retículos completos se definen en Isabelle
como clases:

Retículo: \\
class lattice $=$ \\
  assumes ex-inf : $\exists$ inf. is-inf x y inf. \\
  assumes ex-sup : $\exists$ sup. is-sup x y sup. \\

Retículo completo: \\
class complete-lattice $=$ lattice $+$ Inf $+$ Sup $+$ bot $+$ top $+$
 \\
  assumes Inf-lower : $x \in A \Longrightarrow A \leq x$ \\
  and Inf-greatest : $(\bigwedge x. x \in A \Longrightarrow z \leq x)
\Longrightarrow z \leq \sqcap A.$ \\
    and Sup-upper : $x \in A \Longrightarrow x \leq \sqcup A$ \\
    and Sup-least : $(\bigwedge x. x \in A \Longrightarrow x \leq z)
\Longrightarrow \sqcup A \leq z$ \\
    and Inf-empty $[$simp$]$ : $\sqcap \{\} = \top$ \\
    and Sup-empty $[$simp$]$ : $\sqcup \{\} = \bot$ \\

Para la especificiación del teorema también debemos notar que:

$$f :: "'a :: @{text "complete_latices"} \Rightarrow 'a"$$

significa que $f$ es una función cuyo dominio y codominio es un retículo
completo.

La especifiación del teorema es:
\<close>

theorem Knaster_Tarski:
  fixes f :: "'a :: complete_lattice \<Rightarrow> 'a"
  assumes "mono f"
  shows "\<exists>a. f a = a"
  oops

  text \<open>
A continuación presentaremos distintas demostraciones del teorema.
\<close>

  subsection \<open>
Demostración detallada
\<close>

theorem Knaster_Tarski_detallada:
  fixes f :: "'a :: complete_lattice \<Rightarrow> 'a"
  assumes "mono f"
  shows "\<exists>a. f a = a"
proof
  let ?H = "{u. f u \<le> u}"
  let ?a = "\<Sqinter>?H"
  show "f ?a = ?a"
  proof -
    have "f ?a \<le> ?a"
    proof (rule Inf_greatest)
      fix x
      assume "x \<in> ?H"
      then have "?a \<le> x"
        by (rule Inf_lower)
      with \<open>mono f\<close> have "f ?a \<le> f x"
        by (rule monoD)
      also have "f x \<le> x"
        using \<open>x \<in> ?H\<close>
        by (rule CollectE)
      finally show "f ?a \<le> x"
        by this
    qed
    from \<open>mono f\<close> and \<open>f ?a \<le> ?a\<close> have "f (f ?a) \<le> f ?a"
      by (rule monoD)
    then have "f ?a \<in> ?H"
      by (rule CollectI)
    then have "?a \<le> f ?a"
      by (rule Inf_lower)
    show ?thesis
      using \<open>f ?a \<le> ?a\<close>
            \<open>?a \<le> f ?a\<close>
      by (rule order_antisym)
  qed
qed

subsection \<open> Demostración automática \<close>

theorem Knaster_Tarski_automatica:
  fixes f :: "'a :: complete_lattice \<Rightarrow> 'a"
  assumes "mono f"
  shows "\<exists>a. f a = a"
proof
  let ?H = "{u. f u \<le> u}"
  let ?a = "\<Sqinter>?H"
  show "f ?a = ?a"
  proof -
    have "f ?a \<le> ?a"
    proof (rule Inf_greatest)
      fix x
      assume "x \<in> ?H"
      then have "?a \<le> x"
        by (simp add: Inf_lower)
      then show "f ?a \<le> x"
        by (metis (mono_tags, lifting) \<open>x \<in> ?H\<close> assms le_INF_iff
            mem_Collect_eq mono_Inf order.trans)
    qed
    then show "f ?a = ?a"
      by (meson CollectI Inf_lower antisym assms mono_def)
  qed
qed

(*<*)
end
(*>*)


theory extended_int
imports Ordered_Abelian_Group Main Extended_OAG
begin

abbreviation int_group :: "int monoid"
  where "int_group \<equiv> \<lparr>carrier = UNIV, mult = (+), one = 0\<rparr>"

abbreviation int_oag :: "int ordered_monoid"
  where "int_oag \<equiv> \<lparr>carrier = UNIV, mult = (+), one = 0, le = (\<le>) \<rparr>"

lemma int_oag_is_oag:
"ordered_abelian_group int_oag"
proof(rule oagI)
  show "comm_group int_oag"
    apply(rule comm_groupI)
    apply(simp)
    apply(simp)
    apply(simp)
    apply(simp)
    apply(simp)
    apply(simp)
    apply presburger
    done
  show "has_order int_oag"
  proof
    show "\<And>x. x \<in> carrier (underlying_order int_oag) \<Longrightarrow> x .=\<^bsub>underlying_order int_oag\<^esub> x"
      by simp
    show " \<And>x y. x .=\<^bsub>underlying_order int_oag\<^esub> y \<Longrightarrow>
           x \<in> carrier (underlying_order int_oag) \<Longrightarrow> y \<in> carrier (underlying_order int_oag) \<Longrightarrow> y .=\<^bsub>underlying_order int_oag\<^esub> x"
      by auto
    show "\<And>x y z.
       x .=\<^bsub>underlying_order int_oag\<^esub> y \<Longrightarrow>
       y .=\<^bsub>underlying_order int_oag\<^esub> z \<Longrightarrow>
       x \<in> carrier (underlying_order int_oag) \<Longrightarrow>
       y \<in> carrier (underlying_order int_oag) \<Longrightarrow> z \<in> carrier (underlying_order int_oag) \<Longrightarrow> x .=\<^bsub>underlying_order int_oag\<^esub> z"
      by simp
    show " \<And>x. x \<in> carrier (underlying_order int_oag) \<Longrightarrow> x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> x"
      by simp
    show "\<And>x y. x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> y \<Longrightarrow>
           y \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> x \<Longrightarrow>
           x \<in> carrier (underlying_order int_oag) \<Longrightarrow> y \<in> carrier (underlying_order int_oag) \<Longrightarrow> x .=\<^bsub>underlying_order int_oag\<^esub> y"
      by auto
    show "\<And>x y z.
       x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> y \<Longrightarrow>
       y \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> z \<Longrightarrow>
       x \<in> carrier (underlying_order int_oag) \<Longrightarrow>
       y \<in> carrier (underlying_order int_oag) \<Longrightarrow> z \<in> carrier (underlying_order int_oag) \<Longrightarrow> x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> z"
      by simp
    show "\<And>x y z w.
       x .=\<^bsub>underlying_order int_oag\<^esub> y \<Longrightarrow>
       z .=\<^bsub>underlying_order int_oag\<^esub> w \<Longrightarrow>
       x \<in> carrier (underlying_order int_oag) \<Longrightarrow>
       y \<in> carrier (underlying_order int_oag) \<Longrightarrow>
       z \<in> carrier (underlying_order int_oag) \<Longrightarrow>
       w \<in> carrier (underlying_order int_oag) \<Longrightarrow> (x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> z) = (y \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> w)"
      by auto
    show "(.=\<^bsub>underlying_order int_oag\<^esub>) = (=)"
      by simp
    show " \<And>x y. x \<in> carrier (underlying_order int_oag) \<Longrightarrow>
           y \<in> carrier (underlying_order int_oag) \<Longrightarrow> x \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> y \<or> y \<sqsubseteq>\<^bsub>underlying_order int_oag\<^esub> x"
      by (simp add: linear)
  qed
  show " le_resp_mult int_oag"
    by (simp add: le_resp_mult_def)
qed

abbreviation int_eoag :: "int option extended_ordered_monoid" where
  "int_eoag \<equiv> (extended int_oag)"

lemma int_eoag_is_eoag:
"extended_ordered_abelian_group int_eoag"
 using ordered_abelian_group.extended_is_eoag  int_oag_is_oag by blast

end


theory PDS_Code
  imports PDS "Deriving.Derive"
begin

global_interpretation pds: PDS_with_P_automata \<Delta> F_ctr_loc F_ctr_loc_st
  for \<Delta> :: "('ctr_loc::{enum, linorder}, 'label::{finite, linorder}) rule set"
  and F_ctr_loc :: "('ctr_loc) set"
  and F_ctr_loc_st :: "('state::finite) set"
  defines pre_star = "PDS_with_P_automata.pre_star_exec \<Delta>"
  and pre_star_check = "PDS_with_P_automata.pre_star_exec_check \<Delta>"
  and inits = "PDS_with_P_automata.inits"
  and finals = "PDS_with_P_automata.finals F_ctr_loc F_ctr_loc_st"
  and accepts = "PDS_with_P_automata.accepts F_ctr_loc F_ctr_loc_st"
  and language = "PDS_with_P_automata.lang F_ctr_loc F_ctr_loc_st"
  and step_starp = "rtranclp (LTS.step_relp (PDS.transition_rel \<Delta>))"
  and accepts_pre_star_check = "PDS_with_P_automata.accept_pre_star_exec_check \<Delta> F_ctr_loc F_ctr_loc_st"
  .

global_interpretation inter: Intersection_P_Automaton
  initial_automaton inits "finals initial_F_ctr_loc initial_F_ctr_loc_st"
  "pre_star \<Delta> final_automaton" "finals final_F_ctr_loc final_F_ctr_loc_st"
  for \<Delta> :: "('ctr_loc::{enum, linorder}, 'label::{finite, linorder}) rule set"
  and initial_automaton :: "(('ctr_loc, 'state::finite, 'label) state, 'label) transition set"
  and initial_F_ctr_loc :: "'ctr_loc set"
  and initial_F_ctr_loc_st :: "'state set"
  and final_automaton :: "(('ctr_loc, 'state, 'label) state, 'label) transition set"
  and final_F_ctr_loc :: "'ctr_loc set"
  and final_F_ctr_loc_st :: "'state set"
  defines nonempty_inter = "P_Automaton.nonempty
    (inters initial_automaton (pre_star \<Delta> final_automaton))
    ((\<lambda>x. (x,x)) ` inits)
    (inters_finals (finals initial_F_ctr_loc initial_F_ctr_loc_st)
                   (finals final_F_ctr_loc final_F_ctr_loc_st))"
  .

definition "check \<Delta> I IF IF_st F FF FF_st =
  (if pds.inits \<subseteq> LTS.srcs F then Some (nonempty_inter \<Delta> I IF IF_st F FF FF_st) else None)"

lemma check_None: "check \<Delta> I IF IF_st F FF FF_st = None \<longleftrightarrow> \<not> (inits \<subseteq> LTS.srcs F)"
  unfolding check_def by auto

lemma check_Some: "check \<Delta> I IF IF_st F FF FF_st = Some b \<longleftrightarrow>
  (inits \<subseteq> LTS.srcs F \<and> b = (\<exists>p w p' w'.
     (p, w) \<in> language IF IF_st I \<and>
     (p', w') \<in> language FF FF_st F \<and>
     step_starp \<Delta> (p, w) (p', w')))"
  unfolding check_def nonempty_inter_def P_Automaton.nonempty_def
    inter.lang_aut_alt inter.inters_lang
    pds.lang_aut_lang
  by (auto 0 5 simp: pds.pre_star_exec_lang_correct pds.pre_star_def image_iff
    elim!: bexI[rotated])

declare P_Automaton.mark.simps[code]

export_code check in SML

end


(*<*)
theory GoedelGod
imports Main

begin
(*>*)

section \<open>Introduction\<close>

 text \<open>Dana Scott's version \<^cite>\<open>"ScottNotes"\<close> (cf.~Fig.~1)
 of G\"odel's proof of God's existence \<^cite>\<open>"GoedelNotes"\<close> is
 formalized in quantified modal logic KB (QML KB) within the proof assistant Isabelle/HOL.
 QML KB is  modeled as a fragment of classical higher-order logic (HOL);
 thus, the formalization is essentially a formalization in HOL. The employed embedding
 of QML KB in HOL is adapting the work of Benzm\"uller and Paulson \<^cite>\<open>"J23" and "B9"\<close>.
 Note that the QML KB formalization employs quantification over individuals and
 quantification over sets of individuals (properties).

 The gaps in Scott's proof have been automated
 with Sledgehammer \<^cite>\<open>"Sledgehammer"\<close>, performing remote calls to the higher-order automated
 theorem prover LEO-II \<^cite>\<open>"LEO-II"\<close>. Sledgehammer suggests the
 Metis \<^cite>\<open>"Metis"\<close> calls, which result in proofs that are verified by Isabelle/HOL.
 For consistency checking, the model finder Nitpick \<^cite>\<open>"Nitpick"\<close> has been employed.
 The successfull calls to Sledgehammer
 are deliberately kept as comments in the file for demonstration purposes
 (normally, they are automatically eliminated by Isabelle/HOL).

 Isabelle is described in the textbook by Nipkow,
 Paulson, and Wenzel \<^cite>\<open>"Isabelle"\<close> and in tutorials available
 at: @{url "http://isabelle.in.tum.de"}.

\subsection{Related Work}

 The formalization presented here is related to the THF \<^cite>\<open>"J22"\<close> and
 Coq \<^cite>\<open>"Coq"\<close> formalizations at
 @{url "https://github.com/FormalTheology/GoedelGod/tree/master/Formalizations/"}.

 An older ontological argument by Anselm was formalized in PVS by John Rushby \<^cite>\<open>"rushby"\<close>.
\<close>

section \<open>An Embedding of QML KB in HOL\<close>

text \<open>The types \<open>i\<close> for possible worlds and $\mu$ for individuals are introduced.\<close>

  typedecl i    \<comment> \<open>the type for possible worlds\<close>
  typedecl \<mu>    \<comment> \<open>the type for indiviuals\<close>

text \<open>Possible worlds are connected by an accessibility relation \<open>r\<close>.\<close>

  consts r :: "i \<Rightarrow> i \<Rightarrow> bool" (infixr "r" 70)    \<comment> \<open>accessibility relation r\<close>

text \<open>QML formulas are translated as HOL terms of type @{typ "i \<Rightarrow> bool"}.
This type is abbreviated as \<open>\<sigma>\<close>.\<close>

  type_synonym \<sigma> = "(i \<Rightarrow> bool)"

text \<open>The classical connectives $\neg, \wedge, \rightarrow$, and $\forall$
(over individuals and over sets of individuals) and $\exists$ (over individuals) are
lifted to type $\sigma$. The lifted connectives are \<open>m\<not>\<close>, \<open>m\<and>\<close>, \<open>m\<rightarrow>\<close>,
\<open>\<forall>\<close>, and \<open>\<exists>\<close> (the latter two are modeled as constant symbols).
Other connectives can be introduced analogously. We exemplarily do this for \<open>m\<or>\<close> ,
\<open>m\<equiv>\<close>, and \<open>mL=\<close> (Leibniz equality on individuals). Moreover, the modal
operators \<open>\<box>\<close> and \<open>\<diamond>\<close>  are introduced. Definitions could be used instead of
abbreviations.\<close>

  abbreviation mnot :: "\<sigma> \<Rightarrow> \<sigma>" ("m\<not>") where "m\<not> \<phi> \<equiv> (\<lambda>w. \<not> \<phi> w)"
  abbreviation mand :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<and>" 65) where "\<phi> m\<and> \<psi> \<equiv> (\<lambda>w. \<phi> w \<and> \<psi> w)"
  abbreviation mor :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<or>" 70) where "\<phi> m\<or> \<psi> \<equiv> (\<lambda>w. \<phi> w \<or> \<psi> w)"
  abbreviation mimplies :: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<rightarrow>" 74) where "\<phi> m\<rightarrow> \<psi> \<equiv> (\<lambda>w. \<phi> w \<longrightarrow> \<psi> w)"
  abbreviation mequiv:: "\<sigma> \<Rightarrow> \<sigma> \<Rightarrow> \<sigma>" (infixr "m\<equiv>" 76) where "\<phi> m\<equiv> \<psi> \<equiv> (\<lambda>w. \<phi> w \<longleftrightarrow> \<psi> w)"
  abbreviation mforall :: "('a \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<forall>") where "\<forall> \<Phi> \<equiv> (\<lambda>w. \<forall>x. \<Phi> x w)"
  abbreviation mexists :: "('a \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>" ("\<exists>") where "\<exists> \<Phi> \<equiv> (\<lambda>w. \<exists>x. \<Phi> x w)"
  abbreviation mLeibeq :: "\<mu> \<Rightarrow> \<mu> \<Rightarrow> \<sigma>" (infixr "mL=" 90) where "x mL= y \<equiv> \<forall>(\<lambda>\<phi>. (\<phi> x m\<rightarrow> \<phi> y))"
  abbreviation mbox :: "\<sigma> \<Rightarrow> \<sigma>" ("\<box>") where "\<box> \<phi> \<equiv> (\<lambda>w. \<forall>v.  w r v \<longrightarrow> \<phi> v)"
  abbreviation mdia :: "\<sigma> \<Rightarrow> \<sigma>" ("\<diamond>") where "\<diamond> \<phi> \<equiv> (\<lambda>w. \<exists>v. w r v \<and> \<phi> v)"

text \<open>For grounding lifted formulas, the meta-predicate \<open>valid\<close> is introduced.\<close>

  (*<*) no_syntax "_list" :: "args \<Rightarrow> 'a list" ("[(_)]") (*>*)
  abbreviation valid :: "\<sigma> \<Rightarrow> bool" ("[_]") where "[p] \<equiv> \<forall>w. p w"

section \<open>G\"odel's Ontological Argument\<close>

text \<open>Constant symbol \<open>P\<close> (G\"odel's `Positive') is declared.\<close>

  consts P :: "(\<mu> \<Rightarrow> \<sigma>) \<Rightarrow> \<sigma>"

text \<open>The meaning of \<open>P\<close> is restricted by axioms \<open>A1(a/b)\<close>: $\all \phi
[P(\neg \phi) \biimp \neg P(\phi)]$ (Either a property or its negation is positive, but not both.)
and \<open>A2\<close>: $\all \phi \all \psi [(P(\phi) \wedge \nec \all x [\phi(x) \imp \psi(x)])
\imp P(\psi)]$ (A property necessarily implied by a positive property is positive).\<close>

  axiomatization where
    A1a: "[\<forall>(\<lambda>\<Phi>. P (\<lambda>x. m\<not> (\<Phi> x)) m\<rightarrow> m\<not> (P \<Phi>))]" and
    A1b: "[\<forall>(\<lambda>\<Phi>. m\<not> (P \<Phi>) m\<rightarrow> P (\<lambda>x. m\<not> (\<Phi> x)))]" and
    A2:  "[\<forall>(\<lambda>\<Phi>. \<forall>(\<lambda>\<Psi>. (P \<Phi> m\<and> \<box> (\<forall>(\<lambda>x. \<Phi> x m\<rightarrow> \<Psi> x))) m\<rightarrow> P \<Psi>))]"

text \<open>We prove theorem T1: $\all \phi [P(\phi) \imp \pos \ex x \phi(x)]$ (Positive
properties are possibly exemplified). T1 is proved directly by Sledgehammer with command \<open>sledgehammer [provers = remote_leo2]\<close>.
Sledgehammer suggests to call Metis with axioms A1a and A2.
Metis sucesfully generates a proof object
that is verified in Isabelle/HOL's kernel.\<close>

  theorem T1: "[\<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<diamond> (\<exists> \<Phi>))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1a A2)

text \<open>Next, the symbol \<open>G\<close> for `God-like'  is introduced and defined
as $G(x) \biimp \forall \phi [P(\phi) \to \phi(x)]$ \\ (A God-like being possesses
all positive properties).\<close>

  definition G :: "\<mu> \<Rightarrow> \<sigma>" where "G = (\<lambda>x. \<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<Phi> x))"

text \<open>Axiom \<open>A3\<close> is added: $P(G)$ (The property of being God-like is positive).
Sledgehammer and Metis then prove corollary \<open>C\<close>: $\pos \ex x G(x)$
(Possibly, God exists).\<close>

  axiomatization where A3:  "[P G]"

  corollary C: "[\<diamond> (\<exists> G)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A3 T1)

text \<open>Axiom \<open>A4\<close> is added: $\all \phi [P(\phi) \to \Box \; P(\phi)]$
(Positive properties are necessarily positive).\<close>

  axiomatization where A4:  "[\<forall>(\<lambda>\<Phi>. P \<Phi> m\<rightarrow> \<box> (P \<Phi>))]"

text \<open>Symbol \<open>ess\<close> for `Essence' is introduced and defined as
$$\ess{\phi}{x} \biimp \phi(x) \wedge \all \psi (\psi(x) \imp \nec \all y (\phi(y)
\imp \psi(y)))$$ (An \emph{essence} of an individual is a property possessed by it and necessarily implying any of its properties).\<close>

  definition ess :: "(\<mu> \<Rightarrow> \<sigma>) \<Rightarrow> \<mu> \<Rightarrow> \<sigma>" (infixr "ess" 85) where
    "\<Phi> ess x = \<Phi> x m\<and> \<forall>(\<lambda>\<Psi>. \<Psi> x m\<rightarrow> \<box> (\<forall>(\<lambda>y. \<Phi> y m\<rightarrow> \<Psi> y)))"

text \<open>Next, Sledgehammer and Metis prove theorem \<open>T2\<close>: $\all x [G(x) \imp \ess{G}{x}]$ \\
(Being God-like is an essence of any God-like being).\<close>

  theorem T2: "[\<forall>(\<lambda>x. G x m\<rightarrow> G ess x)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1b A4 G_def ess_def)

text \<open>Symbol \<open>NE\<close>, for `Necessary Existence', is introduced and
defined as $$\NE(x) \biimp \all \phi [\ess{\phi}{x} \imp \nec \ex y \phi(y)]$$ (Necessary
existence of an individual is the necessary exemplification of all its essences).\<close>

  definition NE :: "\<mu> \<Rightarrow> \<sigma>" where "NE = (\<lambda>x. \<forall>(\<lambda>\<Phi>. \<Phi> ess x m\<rightarrow> \<box> (\<exists> \<Phi>)))"

text \<open>Moreover, axiom \<open>A5\<close> is added: $P(\NE)$ (Necessary existence is a positive
property).\<close>

  axiomatization where A5:  "[P NE]"

text \<open>The \<open>B\<close> axiom (symmetry) for relation r is stated. \<open>B\<close> is needed only
for proving theorem T3 and for corollary C2.\<close>

  axiomatization where sym: "x r y \<longrightarrow> y r x"

text \<open>Finally, Sledgehammer and Metis prove the main theorem \<open>T3\<close>: $\nec \ex x G(x)$ \\
(Necessarily, God exists).\<close>

  theorem T3: "[\<box> (\<exists> G)]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A5 C T2 sym G_def NE_def)

text \<open>Surprisingly, the following corollary can be derived even without the \<open>T\<close> axiom
(reflexivity).\<close>

  corollary C2: "[\<exists> G]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis T1 T3 G_def sym)

text \<open>The consistency of the entire theory is confirmed by Nitpick.\<close>

  lemma True nitpick [satisfy, user_axioms, expect = genuine] oops

section \<open>Additional Results on G\"odel's God.\<close>

text \<open>G\"odel's God is flawless: (s)he does not have non-positive properties.\<close>

  theorem Flawlessness: "[\<forall>(\<lambda>\<Phi>. \<forall>(\<lambda>x. (G x m\<rightarrow> (m\<not> (P \<Phi>) m\<rightarrow> m\<not> (\<Phi> x)))))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis A1b G_def)

text \<open>There is only one God: any two God-like beings are equal.\<close>

  theorem Monotheism: "[\<forall>(\<lambda>x.\<forall>(\<lambda>y. (G x m\<rightarrow> (G y m\<rightarrow> (x mL= y)))))]"
  \<comment> \<open>sledgehammer [provers = remote\_leo2]\<close>
  by (metis Flawlessness G_def)

section \<open>Modal Collapse\<close>

text \<open>G\"odel's axioms have been criticized for entailing the so-called
modal collapse. The prover Satallax \<^cite>\<open>"Satallax"\<close> confirms this.
However, sledgehammer is not able to determine which axioms,
definitions and previous theorems are used by Satallax;
hence it suggests to call Metis using everything, but this (unsurprinsingly) fails.
Attempting to use `Sledegehammer min' to minimize Sledgehammer's suggestion does not work.
Calling Metis with \<open>T2\<close>, \<open>T3\<close> and \<open>ess_def\<close> also does not work.\<close>

  lemma MC: "[\<forall>(\<lambda>\<Phi>.(\<Phi> m\<rightarrow> (\<box> \<Phi>)))]"
  \<comment> \<open>sledgehammer [provers = remote\_satallax]\<close>
  \<comment> \<open>by (metis T2 T3 ess\_def)\<close>
  oops
(*<*)
end
(*>*)