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

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

datatype Nat = Z | S "Nat"

datatype Heap = Node "Heap" "Nat" "Heap" | Nil

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

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

fun hmerge :: "Heap => Heap => Heap" where
  "hmerge (Node z x2 x3) (Node x4 x5 x6) =
   (if le x2 x5 then Node (hmerge x3 (Node x4 x5 x6)) x2 z else
      Node (hmerge (Node z x2 x3) x6) x5 x4)"
| "hmerge (Node z x2 x3) (Nil) = Node z x2 x3"
| "hmerge (Nil) y = y"

(*fun did not finish the proof*)
function toList :: "Heap => Nat list" where
  "toList (Node q y r) = cons2 y (toList (hmerge q r))"
| "toList (Nil) = nil2"
  by pat_completeness auto

fun hinsert :: "Nat => Heap => Heap" where
  "hinsert x y = hmerge (Node Nil x Nil) y"

fun toHeap2 :: "Nat list => Heap" where
  "toHeap2 (nil2) = Nil"
| "toHeap2 (cons2 y xs) = hinsert y (toHeap2 xs)"

fun hsort2 :: "Nat list => Nat list" where
  "hsort2 x = toList (toHeap2 x)"

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

theorem property0 :
  "((count x (hsort2 xs)) = (count x xs))"
  oops

end


theory T20
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


(*  Title:      HOL/Library/Liminf_Limsup.thy
    Author:     Johannes Hölzl, TU München
    Author:     Manuel Eberl, TU München
*)

section \<open>Liminf and Limsup on conditionally complete lattices\<close>

theory Liminf_Limsup
imports Complex_Main
begin

lemma (in conditionally_complete_linorder) le_cSup_iff:
  assumes "A \<noteq> {}" "bdd_above A"
  shows "x \<le> Sup A \<longleftrightarrow> (\<forall>y<x. \<exists>a\<in>A. y < a)"
proof safe
  fix y assume "x \<le> Sup A" "y < x"
  then have "y < Sup A" by auto
  then show "\<exists>a\<in>A. y < a"
    unfolding less_cSup_iff[OF assms] .
qed (auto elim!: allE[of _ "Sup A"] simp add: not_le[symmetric] cSup_upper assms)

lemma (in conditionally_complete_linorder) le_cSUP_iff:
  "A \<noteq> {} \<Longrightarrow> bdd_above (f`A) \<Longrightarrow> x \<le> SUPREMUM A f \<longleftrightarrow> (\<forall>y<x. \<exists>i\<in>A. y < f i)"
  using le_cSup_iff [of "f ` A"] by simp

lemma le_cSup_iff_less:
  fixes x :: "'a :: {conditionally_complete_linorder, dense_linorder}"
  shows "A \<noteq> {} \<Longrightarrow> bdd_above (f`A) \<Longrightarrow> x \<le> (SUP i:A. f i) \<longleftrightarrow> (\<forall>y<x. \<exists>i\<in>A. y \<le> f i)"
  by (simp add: le_cSUP_iff)
     (blast intro: less_imp_le less_trans less_le_trans dest: dense)

lemma le_Sup_iff_less:
  fixes x :: "'a :: {complete_linorder, dense_linorder}"
  shows "x \<le> (SUP i:A. f i) \<longleftrightarrow> (\<forall>y<x. \<exists>i\<in>A. y \<le> f i)" (is "?lhs = ?rhs")
  unfolding le_SUP_iff
  by (blast intro: less_imp_le less_trans less_le_trans dest: dense)

lemma (in conditionally_complete_linorder) cInf_le_iff:
  assumes "A \<noteq> {}" "bdd_below A"
  shows "Inf A \<le> x \<longleftrightarrow> (\<forall>y>x. \<exists>a\<in>A. y > a)"
proof safe
  fix y assume "x \<ge> Inf A" "y > x"
  then have "y > Inf A" by auto
  then show "\<exists>a\<in>A. y > a"
    unfolding cInf_less_iff[OF assms] .
qed (auto elim!: allE[of _ "Inf A"] simp add: not_le[symmetric] cInf_lower assms)

lemma (in conditionally_complete_linorder) cINF_le_iff:
  "A \<noteq> {} \<Longrightarrow> bdd_below (f`A) \<Longrightarrow> INFIMUM A f \<le> x \<longleftrightarrow> (\<forall>y>x. \<exists>i\<in>A. y > f i)"
  using cInf_le_iff [of "f ` A"] by simp

lemma cInf_le_iff_less:
  fixes x :: "'a :: {conditionally_complete_linorder, dense_linorder}"
  shows "A \<noteq> {} \<Longrightarrow> bdd_below (f`A) \<Longrightarrow> (INF i:A. f i) \<le> x \<longleftrightarrow> (\<forall>y>x. \<exists>i\<in>A. f i \<le> y)"
  by (simp add: cINF_le_iff)
     (blast intro: less_imp_le less_trans le_less_trans dest: dense)

lemma Inf_le_iff_less:
  fixes x :: "'a :: {complete_linorder, dense_linorder}"
  shows "(INF i:A. f i) \<le> x \<longleftrightarrow> (\<forall>y>x. \<exists>i\<in>A. f i \<le> y)"
  unfolding INF_le_iff
  by (blast intro: less_imp_le less_trans le_less_trans dest: dense)

lemma SUP_pair:
  fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: complete_lattice"
  shows "(SUP i : A. SUP j : B. f i j) = (SUP p : A \<times> B. f (fst p) (snd p))"
  by (rule antisym) (auto intro!: SUP_least SUP_upper2)

lemma INF_pair:
  fixes f :: "_ \<Rightarrow> _ \<Rightarrow> _ :: complete_lattice"
  shows "(INF i : A. INF j : B. f i j) = (INF p : A \<times> B. f (fst p) (snd p))"
  by (rule antisym) (auto intro!: INF_greatest INF_lower2)

subsubsection \<open>\<open>Liminf\<close> and \<open>Limsup\<close>\<close>

definition Liminf :: "'a filter \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b :: complete_lattice" where
  "Liminf F f = (SUP P:{P. eventually P F}. INF x:{x. P x}. f x)"

definition Limsup :: "'a filter \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b :: complete_lattice" where
  "Limsup F f = (INF P:{P. eventually P F}. SUP x:{x. P x}. f x)"

abbreviation "liminf \<equiv> Liminf sequentially"

abbreviation "limsup \<equiv> Limsup sequentially"

lemma Liminf_eqI:
  "(\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> x) \<Longrightarrow>
    (\<And>y. (\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> y) \<Longrightarrow> x \<le> y) \<Longrightarrow> Liminf F f = x"
  unfolding Liminf_def by (auto intro!: SUP_eqI)

lemma Limsup_eqI:
  "(\<And>P. eventually P F \<Longrightarrow> x \<le> SUPREMUM (Collect P) f) \<Longrightarrow>
    (\<And>y. (\<And>P. eventually P F \<Longrightarrow> y \<le> SUPREMUM (Collect P) f) \<Longrightarrow> y \<le> x) \<Longrightarrow> Limsup F f = x"
  unfolding Limsup_def by (auto intro!: INF_eqI)

lemma liminf_SUP_INF: "liminf f = (SUP n. INF m:{n..}. f m)"
  unfolding Liminf_def eventually_sequentially
  by (rule SUP_eq) (auto simp: atLeast_def intro!: INF_mono)

lemma limsup_INF_SUP: "limsup f = (INF n. SUP m:{n..}. f m)"
  unfolding Limsup_def eventually_sequentially
  by (rule INF_eq) (auto simp: atLeast_def intro!: SUP_mono)

lemma Limsup_const:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Limsup F (\<lambda>x. c) = c"
proof -
  have *: "\<And>P. Ex P \<longleftrightarrow> P \<noteq> (\<lambda>x. False)" by auto
  have "\<And>P. eventually P F \<Longrightarrow> (SUP x : {x. P x}. c) = c"
    using ntriv by (intro SUP_const) (auto simp: eventually_False *)
  then show ?thesis
    unfolding Limsup_def using eventually_True
    by (subst INF_cong[where D="\<lambda>x. c"])
       (auto intro!: INF_const simp del: eventually_True)
qed

lemma Liminf_const:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Liminf F (\<lambda>x. c) = c"
proof -
  have *: "\<And>P. Ex P \<longleftrightarrow> P \<noteq> (\<lambda>x. False)" by auto
  have "\<And>P. eventually P F \<Longrightarrow> (INF x : {x. P x}. c) = c"
    using ntriv by (intro INF_const) (auto simp: eventually_False *)
  then show ?thesis
    unfolding Liminf_def using eventually_True
    by (subst SUP_cong[where D="\<lambda>x. c"])
       (auto intro!: SUP_const simp del: eventually_True)
qed

lemma Liminf_mono:
  assumes ev: "eventually (\<lambda>x. f x \<le> g x) F"
  shows "Liminf F f \<le> Liminf F g"
  unfolding Liminf_def
proof (safe intro!: SUP_mono)
  fix P assume "eventually P F"
  with ev have "eventually (\<lambda>x. f x \<le> g x \<and> P x) F" (is "eventually ?Q F") by (rule eventually_conj)
  then show "\<exists>Q\<in>{P. eventually P F}. INFIMUM (Collect P) f \<le> INFIMUM (Collect Q) g"
    by (intro bexI[of _ ?Q]) (auto intro!: INF_mono)
qed

lemma Liminf_eq:
  assumes "eventually (\<lambda>x. f x = g x) F"
  shows "Liminf F f = Liminf F g"
  by (intro antisym Liminf_mono eventually_mono[OF assms]) auto

lemma Limsup_mono:
  assumes ev: "eventually (\<lambda>x. f x \<le> g x) F"
  shows "Limsup F f \<le> Limsup F g"
  unfolding Limsup_def
proof (safe intro!: INF_mono)
  fix P assume "eventually P F"
  with ev have "eventually (\<lambda>x. f x \<le> g x \<and> P x) F" (is "eventually ?Q F") by (rule eventually_conj)
  then show "\<exists>Q\<in>{P. eventually P F}. SUPREMUM (Collect Q) f \<le> SUPREMUM (Collect P) g"
    by (intro bexI[of _ ?Q]) (auto intro!: SUP_mono)
qed

lemma Limsup_eq:
  assumes "eventually (\<lambda>x. f x = g x) net"
  shows "Limsup net f = Limsup net g"
  by (intro antisym Limsup_mono eventually_mono[OF assms]) auto

lemma Liminf_bot[simp]: "Liminf bot f = top"
  unfolding Liminf_def top_unique[symmetric]
  by (rule SUP_upper2[where i="\<lambda>x. False"]) simp_all

lemma Limsup_bot[simp]: "Limsup bot f = bot"
  unfolding Limsup_def bot_unique[symmetric]
  by (rule INF_lower2[where i="\<lambda>x. False"]) simp_all

lemma Liminf_le_Limsup:
  assumes ntriv: "\<not> trivial_limit F"
  shows "Liminf F f \<le> Limsup F f"
  unfolding Limsup_def Liminf_def
  apply (rule SUP_least)
  apply (rule INF_greatest)
proof safe
  fix P Q assume "eventually P F" "eventually Q F"
  then have "eventually (\<lambda>x. P x \<and> Q x) F" (is "eventually ?C F") by (rule eventually_conj)
  then have not_False: "(\<lambda>x. P x \<and> Q x) \<noteq> (\<lambda>x. False)"
    using ntriv by (auto simp add: eventually_False)
  have "INFIMUM (Collect P) f \<le> INFIMUM (Collect ?C) f"
    by (rule INF_mono) auto
  also have "\<dots> \<le> SUPREMUM (Collect ?C) f"
    using not_False by (intro INF_le_SUP) auto
  also have "\<dots> \<le> SUPREMUM (Collect Q) f"
    by (rule SUP_mono) auto
  finally show "INFIMUM (Collect P) f \<le> SUPREMUM (Collect Q) f" .
qed

lemma Liminf_bounded:
  assumes le: "eventually (\<lambda>n. C \<le> X n) F"
  shows "C \<le> Liminf F X"
  using Liminf_mono[OF le] Liminf_const[of F C]
  by (cases "F = bot") simp_all

lemma Limsup_bounded:
  assumes le: "eventually (\<lambda>n. X n \<le> C) F"
  shows "Limsup F X \<le> C"
  using Limsup_mono[OF le] Limsup_const[of F C]
  by (cases "F = bot") simp_all

lemma le_Limsup:
  assumes F: "F \<noteq> bot" and x: "\<forall>\<^sub>F x in F. l \<le> f x"
  shows "l \<le> Limsup F f"
  using F Liminf_bounded Liminf_le_Limsup order.trans x by blast

lemma Liminf_le:
  assumes F: "F \<noteq> bot" and x: "\<forall>\<^sub>F x in F. f x \<le> l"
  shows "Liminf F f \<le> l"
  using F Liminf_le_Limsup Limsup_bounded order.trans x by blast

lemma le_Liminf_iff:
  fixes X :: "_ \<Rightarrow> _ :: complete_linorder"
  shows "C \<le> Liminf F X \<longleftrightarrow> (\<forall>y<C. eventually (\<lambda>x. y < X x) F)"
proof -
  have "eventually (\<lambda>x. y < X x) F"
    if "eventually P F" "y < INFIMUM (Collect P) X" for y P
    using that by (auto elim!: eventually_mono dest: less_INF_D)
  moreover
  have "\<exists>P. eventually P F \<and> y < INFIMUM (Collect P) X"
    if "y < C" and y: "\<forall>y<C. eventually (\<lambda>x. y < X x) F" for y P
  proof (cases "\<exists>z. y < z \<and> z < C")
    case True
    then obtain z where z: "y < z \<and> z < C" ..
    moreover from z have "z \<le> INFIMUM {x. z < X x} X"
      by (auto intro!: INF_greatest)
    ultimately show ?thesis
      using y by (intro exI[of _ "\<lambda>x. z < X x"]) auto
  next
    case False
    then have "C \<le> INFIMUM {x. y < X x} X"
      by (intro INF_greatest) auto
    with \<open>y < C\<close> show ?thesis
      using y by (intro exI[of _ "\<lambda>x. y < X x"]) auto
  qed
  ultimately show ?thesis
    unfolding Liminf_def le_SUP_iff by auto
qed

lemma Limsup_le_iff:
  fixes X :: "_ \<Rightarrow> _ :: complete_linorder"
  shows "C \<ge> Limsup F X \<longleftrightarrow> (\<forall>y>C. eventually (\<lambda>x. y > X x) F)"
proof -
  { fix y P assume "eventually P F" "y > SUPREMUM (Collect P) X"
    then have "eventually (\<lambda>x. y > X x) F"
      by (auto elim!: eventually_mono dest: SUP_lessD) }
  moreover
  { fix y P assume "y > C" and y: "\<forall>y>C. eventually (\<lambda>x. y > X x) F"
    have "\<exists>P. eventually P F \<and> y > SUPREMUM (Collect P) X"
    proof (cases "\<exists>z. C < z \<and> z < y")
      case True
      then obtain z where z: "C < z \<and> z < y" ..
      moreover from z have "z \<ge> SUPREMUM {x. z > X x} X"
        by (auto intro!: SUP_least)
      ultimately show ?thesis
        using y by (intro exI[of _ "\<lambda>x. z > X x"]) auto
    next
      case False
      then have "C \<ge> SUPREMUM {x. y > X x} X"
        by (intro SUP_least) (auto simp: not_less)
      with \<open>y > C\<close> show ?thesis
        using y by (intro exI[of _ "\<lambda>x. y > X x"]) auto
    qed }
  ultimately show ?thesis
    unfolding Limsup_def INF_le_iff by auto
qed

lemma less_LiminfD:
  "y < Liminf F (f :: _ \<Rightarrow> 'a :: complete_linorder) \<Longrightarrow> eventually (\<lambda>x. f x > y) F"
  using le_Liminf_iff[of "Liminf F f" F f] by simp

lemma Limsup_lessD:
  "y > Limsup F (f :: _ \<Rightarrow> 'a :: complete_linorder) \<Longrightarrow> eventually (\<lambda>x. f x < y) F"
  using Limsup_le_iff[of F f "Limsup F f"] by simp

lemma lim_imp_Liminf:
  fixes f :: "'a \<Rightarrow> _ :: {complete_linorder,linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
  assumes lim: "(f \<longlongrightarrow> f0) F"
  shows "Liminf F f = f0"
proof (intro Liminf_eqI)
  fix P assume P: "eventually P F"
  then have "eventually (\<lambda>x. INFIMUM (Collect P) f \<le> f x) F"
    by eventually_elim (auto intro!: INF_lower)
  then show "INFIMUM (Collect P) f \<le> f0"
    by (rule tendsto_le[OF ntriv lim tendsto_const])
next
  fix y assume upper: "\<And>P. eventually P F \<Longrightarrow> INFIMUM (Collect P) f \<le> y"
  show "f0 \<le> y"
  proof cases
    assume "\<exists>z. y < z \<and> z < f0"
    then obtain z where "y < z \<and> z < f0" ..
    moreover have "z \<le> INFIMUM {x. z < f x} f"
      by (rule INF_greatest) simp
    ultimately show ?thesis
      using lim[THEN topological_tendstoD, THEN upper, of "{z <..}"] by auto
  next
    assume discrete: "\<not> (\<exists>z. y < z \<and> z < f0)"
    show ?thesis
    proof (rule classical)
      assume "\<not> f0 \<le> y"
      then have "eventually (\<lambda>x. y < f x) F"
        using lim[THEN topological_tendstoD, of "{y <..}"] by auto
      then have "eventually (\<lambda>x. f0 \<le> f x) F"
        using discrete by (auto elim!: eventually_mono)
      then have "INFIMUM {x. f0 \<le> f x} f \<le> y"
        by (rule upper)
      moreover have "f0 \<le> INFIMUM {x. f0 \<le> f x} f"
        by (intro INF_greatest) simp
      ultimately show "f0 \<le> y" by simp
    qed
  qed
qed

lemma lim_imp_Limsup:
  fixes f :: "'a \<Rightarrow> _ :: {complete_linorder,linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
  assumes lim: "(f \<longlongrightarrow> f0) F"
  shows "Limsup F f = f0"
proof (intro Limsup_eqI)
  fix P assume P: "eventually P F"
  then have "eventually (\<lambda>x. f x \<le> SUPREMUM (Collect P) f) F"
    by eventually_elim (auto intro!: SUP_upper)
  then show "f0 \<le> SUPREMUM (Collect P) f"
    by (rule tendsto_le[OF ntriv tendsto_const lim])
next
  fix y assume lower: "\<And>P. eventually P F \<Longrightarrow> y \<le> SUPREMUM (Collect P) f"
  show "y \<le> f0"
  proof (cases "\<exists>z. f0 < z \<and> z < y")
    case True
    then obtain z where "f0 < z \<and> z < y" ..
    moreover have "SUPREMUM {x. f x < z} f \<le> z"
      by (rule SUP_least) simp
    ultimately show ?thesis
      using lim[THEN topological_tendstoD, THEN lower, of "{..< z}"] by auto
  next
    case False
    show ?thesis
    proof (rule classical)
      assume "\<not> y \<le> f0"
      then have "eventually (\<lambda>x. f x < y) F"
        using lim[THEN topological_tendstoD, of "{..< y}"] by auto
      then have "eventually (\<lambda>x. f x \<le> f0) F"
        using False by (auto elim!: eventually_mono simp: not_less)
      then have "y \<le> SUPREMUM {x. f x \<le> f0} f"
        by (rule lower)
      moreover have "SUPREMUM {x. f x \<le> f0} f \<le> f0"
        by (intro SUP_least) simp
      ultimately show "y \<le> f0" by simp
    qed
  qed
qed

lemma Liminf_eq_Limsup:
  fixes f0 :: "'a :: {complete_linorder,linorder_topology}"
  assumes ntriv: "\<not> trivial_limit F"
    and lim: "Liminf F f = f0" "Limsup F f = f0"
  shows "(f \<longlongrightarrow> f0) F"
proof (rule order_tendstoI)
  fix a assume "f0 < a"
  with assms have "Limsup F f < a" by simp
  then obtain P where "eventually P F" "SUPREMUM (Collect P) f < a"
    unfolding Limsup_def INF_less_iff by auto
  then show "eventually (\<lambda>x. f x < a) F"
    by (auto elim!: eventually_mono dest: SUP_lessD)
next
  fix a assume "a < f0"
  with assms have "a < Liminf F f" by simp
  then obtain P where "eventually P F" "a < INFIMUM (Collect P) f"
    unfolding Liminf_def less_SUP_iff by auto
  then show "eventually (\<lambda>x. a < f x) F"
    by (auto elim!: eventually_mono dest: less_INF_D)
qed

lemma tendsto_iff_Liminf_eq_Limsup:
  fixes f0 :: "'a :: {complete_linorder,linorder_topology}"
  shows "\<not> trivial_limit F \<Longrightarrow> (f \<longlongrightarrow> f0) F \<longleftrightarrow> (Liminf F f = f0 \<and> Limsup F f = f0)"
  by (metis Liminf_eq_Limsup lim_imp_Limsup lim_imp_Liminf)

lemma liminf_subseq_mono:
  fixes X :: "nat \<Rightarrow> 'a :: complete_linorder"
  assumes "subseq r"
  shows "liminf X \<le> liminf (X \<circ> r) "
proof-
  have "\<And>n. (INF m:{n..}. X m) \<le> (INF m:{n..}. (X \<circ> r) m)"
  proof (safe intro!: INF_mono)
    fix n m :: nat assume "n \<le> m" then show "\<exists>ma\<in>{n..}. X ma \<le> (X \<circ> r) m"
      using seq_suble[OF \<open>subseq r\<close>, of m] by (intro bexI[of _ "r m"]) auto
  qed
  then show ?thesis by (auto intro!: SUP_mono simp: liminf_SUP_INF comp_def)
qed

lemma limsup_subseq_mono:
  fixes X :: "nat \<Rightarrow> 'a :: complete_linorder"
  assumes "subseq r"
  shows "limsup (X \<circ> r) \<le> limsup X"
proof-
  have "(SUP m:{n..}. (X \<circ> r) m) \<le> (SUP m:{n..}. X m)" for n
  proof (safe intro!: SUP_mono)
    fix m :: nat
    assume "n \<le> m"
    then show "\<exists>ma\<in>{n..}. (X \<circ> r) m \<le> X ma"
      using seq_suble[OF \<open>subseq r\<close>, of m] by (intro bexI[of _ "r m"]) auto
  qed
  then show ?thesis
    by (auto intro!: INF_mono simp: limsup_INF_SUP comp_def)
qed

lemma continuous_on_imp_continuous_within:
  "continuous_on s f \<Longrightarrow> t \<subseteq> s \<Longrightarrow> x \<in> s \<Longrightarrow> continuous (at x within t) f"
  unfolding continuous_on_eq_continuous_within
  by (auto simp: continuous_within intro: tendsto_within_subset)

lemma Liminf_compose_continuous_mono:
  fixes f :: "'a::{complete_linorder, linorder_topology} \<Rightarrow> 'b::{complete_linorder, linorder_topology}"
  assumes c: "continuous_on UNIV f" and am: "mono f" and F: "F \<noteq> bot"
  shows "Liminf F (\<lambda>n. f (g n)) = f (Liminf F g)"
proof -
  { fix P assume "eventually P F"
    have "\<exists>x. P x"
    proof (rule ccontr)
      assume "\<not> (\<exists>x. P x)" then have "P = (\<lambda>x. False)"
        by auto
      with \<open>eventually P F\<close> F show False
        by auto
    qed }
  note * = this

  have "f (Liminf F g) = (SUP P : {P. eventually P F}. f (Inf (g ` Collect P)))"
    unfolding Liminf_def
    by (subst continuous_at_Sup_mono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto intro: eventually_True)
  also have "\<dots> = (SUP P : {P. eventually P F}. INFIMUM (g ` Collect P) f)"
    by (intro SUP_cong refl continuous_at_Inf_mono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto dest!: eventually_happens simp: F)
  finally show ?thesis by (auto simp: Liminf_def)
qed

lemma Limsup_compose_continuous_mono:
  fixes f :: "'a::{complete_linorder, linorder_topology} \<Rightarrow> 'b::{complete_linorder, linorder_topology}"
  assumes c: "continuous_on UNIV f" and am: "mono f" and F: "F \<noteq> bot"
  shows "Limsup F (\<lambda>n. f (g n)) = f (Limsup F g)"
proof -
  { fix P assume "eventually P F"
    have "\<exists>x. P x"
    proof (rule ccontr)
      assume "\<not> (\<exists>x. P x)" then have "P = (\<lambda>x. False)"
        by auto
      with \<open>eventually P F\<close> F show False
        by auto
    qed }
  note * = this

  have "f (Limsup F g) = (INF P : {P. eventually P F}. f (Sup (g ` Collect P)))"
    unfolding Limsup_def
    by (subst continuous_at_Inf_mono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto intro: eventually_True)
  also have "\<dots> = (INF P : {P. eventually P F}. SUPREMUM (g ` Collect P) f)"
    by (intro INF_cong refl continuous_at_Sup_mono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto dest!: eventually_happens simp: F)
  finally show ?thesis by (auto simp: Limsup_def)
qed

lemma Liminf_compose_continuous_antimono:
  fixes f :: "'a::{complete_linorder,linorder_topology} \<Rightarrow> 'b::{complete_linorder,linorder_topology}"
  assumes c: "continuous_on UNIV f"
    and am: "antimono f"
    and F: "F \<noteq> bot"
  shows "Liminf F (\<lambda>n. f (g n)) = f (Limsup F g)"
proof -
  have *: "\<exists>x. P x" if "eventually P F" for P
  proof (rule ccontr)
    assume "\<not> (\<exists>x. P x)" then have "P = (\<lambda>x. False)"
      by auto
    with \<open>eventually P F\<close> F show False
      by auto
  qed
  have "f (Limsup F g) = (SUP P : {P. eventually P F}. f (Sup (g ` Collect P)))"
    unfolding Limsup_def
    by (subst continuous_at_Inf_antimono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto intro: eventually_True)
  also have "\<dots> = (SUP P : {P. eventually P F}. INFIMUM (g ` Collect P) f)"
    by (intro SUP_cong refl continuous_at_Sup_antimono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto dest!: eventually_happens simp: F)
  finally show ?thesis
    by (auto simp: Liminf_def)
qed

lemma Limsup_compose_continuous_antimono:
  fixes f :: "'a::{complete_linorder, linorder_topology} \<Rightarrow> 'b::{complete_linorder, linorder_topology}"
  assumes c: "continuous_on UNIV f" and am: "antimono f" and F: "F \<noteq> bot"
  shows "Limsup F (\<lambda>n. f (g n)) = f (Liminf F g)"
proof -
  { fix P assume "eventually P F"
    have "\<exists>x. P x"
    proof (rule ccontr)
      assume "\<not> (\<exists>x. P x)" then have "P = (\<lambda>x. False)"
        by auto
      with \<open>eventually P F\<close> F show False
        by auto
    qed }
  note * = this

  have "f (Liminf F g) = (INF P : {P. eventually P F}. f (Inf (g ` Collect P)))"
    unfolding Liminf_def
    by (subst continuous_at_Sup_antimono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto intro: eventually_True)
  also have "\<dots> = (INF P : {P. eventually P F}. SUPREMUM (g ` Collect P) f)"
    by (intro INF_cong refl continuous_at_Inf_antimono[OF am continuous_on_imp_continuous_within[OF c]])
       (auto dest!: eventually_happens simp: F)
  finally show ?thesis
    by (auto simp: Limsup_def)
qed

lemma Liminf_filtermap_le: "Liminf (filtermap f F) g \<le> Liminf F (\<lambda>x. g (f x))"
  apply (cases "F = bot", simp)
  by (subst Liminf_def)
    (auto simp add: INF_lower Liminf_bounded eventually_filtermap eventually_mono intro!: SUP_least)

lemma Limsup_filtermap_ge: "Limsup (filtermap f F) g \<ge> Limsup F (\<lambda>x. g (f x))"
  apply (cases "F = bot", simp)
  by (subst Limsup_def)
    (auto simp add: SUP_upper Limsup_bounded eventually_filtermap eventually_mono intro!: INF_greatest)

lemma Liminf_least: "(\<And>P. eventually P F \<Longrightarrow> (INF x:Collect P. f x) \<le> x) \<Longrightarrow> Liminf F f \<le> x"
  by (auto intro!: SUP_least simp: Liminf_def)

lemma Limsup_greatest: "(\<And>P. eventually P F \<Longrightarrow> x \<le> (SUP x:Collect P. f x)) \<Longrightarrow> Limsup F f \<ge> x"
  by (auto intro!: INF_greatest simp: Limsup_def)

lemma Liminf_filtermap_ge: "inj f \<Longrightarrow> Liminf (filtermap f F) g \<ge> Liminf F (\<lambda>x. g (f x))"
  apply (cases "F = bot", simp)
  apply (rule Liminf_least)
  subgoal for P
    by (auto simp: eventually_filtermap the_inv_f_f
        intro!: Liminf_bounded INF_lower2 eventually_mono[of P])
  done

lemma Limsup_filtermap_le: "inj f \<Longrightarrow> Limsup (filtermap f F) g \<le> Limsup F (\<lambda>x. g (f x))"
  apply (cases "F = bot", simp)
  apply (rule Limsup_greatest)
  subgoal for P
    by (auto simp: eventually_filtermap the_inv_f_f
        intro!: Limsup_bounded SUP_upper2 eventually_mono[of P])
  done

lemma Liminf_filtermap_eq: "inj f \<Longrightarrow> Liminf (filtermap f F) g = Liminf F (\<lambda>x. g (f x))"
  using Liminf_filtermap_le[of f F g] Liminf_filtermap_ge[of f F g]
  by simp

lemma Limsup_filtermap_eq: "inj f \<Longrightarrow> Limsup (filtermap f F) g = Limsup F (\<lambda>x. g (f x))"
  using Limsup_filtermap_le[of f F g] Limsup_filtermap_ge[of F g f]
  by simp

subsection \<open>More Limits\<close>

lemma convergent_limsup_cl:
  fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
  shows "convergent X \<Longrightarrow> limsup X = lim X"
  by (auto simp: convergent_def limI lim_imp_Limsup)

lemma convergent_liminf_cl:
  fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
  shows "convergent X \<Longrightarrow> liminf X = lim X"
  by (auto simp: convergent_def limI lim_imp_Liminf)

lemma lim_increasing_cl:
  assumes "\<And>n m. n \<ge> m \<Longrightarrow> f n \<ge> f m"
  obtains l where "f \<longlonglongrightarrow> (l::'a::{complete_linorder,linorder_topology})"
proof
  show "f \<longlonglongrightarrow> (SUP n. f n)"
    using assms
    by (intro increasing_tendsto)
       (auto simp: SUP_upper eventually_sequentially less_SUP_iff intro: less_le_trans)
qed

lemma lim_decreasing_cl:
  assumes "\<And>n m. n \<ge> m \<Longrightarrow> f n \<le> f m"
  obtains l where "f \<longlonglongrightarrow> (l::'a::{complete_linorder,linorder_topology})"
proof
  show "f \<longlonglongrightarrow> (INF n. f n)"
    using assms
    by (intro decreasing_tendsto)
       (auto simp: INF_lower eventually_sequentially INF_less_iff intro: le_less_trans)
qed

lemma compact_complete_linorder:
  fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
  shows "\<exists>l r. subseq r \<and> (X \<circ> r) \<longlonglongrightarrow> l"
proof -
  obtain r where "subseq r" and mono: "monoseq (X \<circ> r)"
    using seq_monosub[of X]
    unfolding comp_def
    by auto
  then have "(\<forall>n m. m \<le> n \<longrightarrow> (X \<circ> r) m \<le> (X \<circ> r) n) \<or> (\<forall>n m. m \<le> n \<longrightarrow> (X \<circ> r) n \<le> (X \<circ> r) m)"
    by (auto simp add: monoseq_def)
  then obtain l where "(X \<circ> r) \<longlonglongrightarrow> l"
     using lim_increasing_cl[of "X \<circ> r"] lim_decreasing_cl[of "X \<circ> r"]
     by auto
  then show ?thesis
    using \<open>subseq r\<close> by auto
qed

lemma tendsto_Limsup:
  fixes f :: "_ \<Rightarrow> 'a :: {complete_linorder,linorder_topology}"
  shows "F \<noteq> bot \<Longrightarrow> Limsup F f = Liminf F f \<Longrightarrow> (f \<longlongrightarrow> Limsup F f) F"
  by (subst tendsto_iff_Liminf_eq_Limsup) auto

lemma tendsto_Liminf:
  fixes f :: "_ \<Rightarrow> 'a :: {complete_linorder,linorder_topology}"
  shows "F \<noteq> bot \<Longrightarrow> Limsup F f = Liminf F f \<Longrightarrow> (f \<longlongrightarrow> Liminf F f) F"
  by (subst tendsto_iff_Liminf_eq_Limsup) auto

end


(*<*)
theory AndersonProof
imports IHOML
begin
nitpick_params[user_axioms=true, show_all, expect=genuine, format = 4,  atoms e = a b c d]
sledgehammer_params[verbose=true]
(*>*)

section \<open>Anderson's Alternative\<close>

text\<open> In this final section, we verify Anderson's emendation of G\"odel's argument, as it is presented in the last
part of the textbook by Fitting (pp. 169-171). \<close>

subsection \<open>General Definitions\<close>

abbreviation existencePredicate::"\<up>\<langle>\<zero>\<rangle>" ("E!")
  where "E! x  \<equiv> \<lambda>w. (\<^bold>\<exists>\<^sup>Ey. y\<^bold>\<approx>x) w"

consts positiveProperty::"\<up>\<langle>\<up>\<langle>\<zero>\<rangle>\<rangle>" ("\<P>")

abbreviation God::"\<up>\<langle>\<zero>\<rangle>" ("G\<^sup>A") where "G\<^sup>A \<equiv> \<lambda>x. \<^bold>\<forall>Y. (\<P> Y) \<^bold>\<leftrightarrow> \<^bold>\<box>(Y x)"

abbreviation Entailment::"\<up>\<langle>\<up>\<langle>\<zero>\<rangle>,\<up>\<langle>\<zero>\<rangle>\<rangle>" (infix "\<Rrightarrow>" 60) where
  "X \<Rrightarrow> Y \<equiv>  \<^bold>\<box>(\<^bold>\<forall>\<^sup>Ez. X z \<^bold>\<rightarrow> Y z)"

subsection \<open>Part I - God's Existence is Possible\<close>

axiomatization where
  A1a:"\<lfloor>\<^bold>\<forall>X. \<P> (\<^bold>\<rightharpoondown>X) \<^bold>\<rightarrow> \<^bold>\<not>(\<P> X) \<rfloor>" and          \<comment> \<open>Axiom 11.3A\<close>
  A2: "\<lfloor>\<^bold>\<forall>X Y. (\<P> X \<^bold>\<and> (X \<Rrightarrow> Y)) \<^bold>\<rightarrow> \<P> Y\<rfloor>" and   \<comment> \<open>Axiom 11.5\<close>
  T2: "\<lfloor>\<P> G\<^sup>A\<rfloor>"                                 \<comment> \<open>Proposition 11.16\<close>

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

theorem T1: "\<lfloor>\<^bold>\<forall>X. \<P> X \<^bold>\<rightarrow> \<^bold>\<diamond>\<^bold>\<exists>\<^sup>E X\<rfloor>"
  using A1a A2 by blast  \<comment> \<open>positive properties are possibly instantiated\<close>
theorem T3: "\<lfloor>\<^bold>\<diamond>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" using T1 T2 by simp  \<comment> \<open>God exists possibly\<close>

subsection \<open>Part II - God's Existence is Necessary if Possible\<close>

text\<open>  \<open>\<P>\<close> now satisfies only one of the stability conditions. But since the argument uses an \emph{S5} logic,
the other stability condition is implied. Therefore \<open>\<P>\<close> becomes rigid (see p. 124).  \<close>
axiomatization where
  A4a: "\<lfloor>\<^bold>\<forall>X. \<P> X \<^bold>\<rightarrow> \<^bold>\<box>(\<P> X)\<rfloor>"      \<comment> \<open>axiom 11.11\<close>

text\<open>  We again postulate our \emph{S5} axioms: \<close>
axiomatization where
 refl: "reflexive aRel" and
 tran: "transitive aRel" and
 symm: "symmetric aRel"

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

abbreviation rigidPred::"('t\<Rightarrow>io)\<Rightarrow>io" where
 "rigidPred \<tau> \<equiv> (\<lambda>\<beta>. \<^bold>\<box>((\<lambda>z. \<beta> \<^bold>\<approx> z) \<^bold>\<down>\<tau>)) \<^bold>\<down>\<tau>"

lemma A4b: "\<lfloor>\<^bold>\<forall>X. \<^bold>\<not>(\<P> X) \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<not>(\<P> X)\<rfloor>"
  using A4a symm by auto \<comment> \<open>symmetry is needed (which corresponds to \emph{B} axiom)\<close>
lemma "\<lfloor>rigidPred \<P>\<rfloor>"
  using A4a A4b by blast \<comment> \<open>@{text "\<P>"} is therefore rigid in a \emph{B} logic\<close>

text\<open>  Essence, Anderson Version (Definition 11.34) \<close>
abbreviation essenceOf::"\<up>\<langle>\<up>\<langle>\<zero>\<rangle>,\<zero>\<rangle>" ("\<E>\<^sup>A") where
  "\<E>\<^sup>A Y x \<equiv> (\<^bold>\<forall>Z. \<^bold>\<box>(Z x) \<^bold>\<leftrightarrow> Y \<Rrightarrow> Z)"

text\<open>  Necessary Existence, Anderson Version (Definition 11.35)  \<close>
abbreviation necessaryExistencePred::"\<up>\<langle>\<zero>\<rangle>" ("NE\<^sup>A")
  where "NE\<^sup>A x  \<equiv> (\<lambda>w. (\<^bold>\<forall>Y.  \<E>\<^sup>A Y x \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E Y) w)"

text\<open>  Theorem 11.36 - If g is God-like, then the property of being God-like is the essence of g. \<close>

text\<open> As shown before, this theorem's proof could be completely automatized for G\"odel's and Fitting's variants.
For Anderson's version however, we had to provide Isabelle with some help based on the corresponding natural-language proof
given by Anderson (see @{cite "anderson90:_some_emend_of_goedel_ontol_proof"} Theorem 2*, p. 296) \<close>
(*Anderson's Proof: Suppose that g is God-like* and necessarily has a property Q. Then
by definition (of "God-like*"), that property is positive. But necessarily, if
Q is positive, then if anything is God-like*, then it has Q -again by the
definition of "God-like* ," together with the fact that if something has a
property necessarily, then it has the property. But if a property is positive,
then it is necessarily positive (Axiom 4). Hence, if Q is positive, then it is
entailed by being God-like* (by modal logic-as in the original Theorem 2).
But Q is positive and hence is entailed by being God-like*. Thus we have
proved that if an entity is God-like* and has a property essentially, then that
property is entailed by the property of being God-like*.
Suppose a property Q is entailed by the property of being God-like*. Then
Q is positive by Axioms 2 and 3* and therefore, since g is God-like*, g has
Q necessarily (by the definition of "God-like*"). Hence, if something is
God-like*, it has a property essentially if and only if that property is entailed
by being God-like-i.e., God-likeness* is an essence* of that thing.
Q.E.D.*)
theorem GodIsEssential: "\<lfloor>\<^bold>\<forall>x. G\<^sup>A x \<^bold>\<rightarrow> (\<E>\<^sup>A G\<^sup>A x)\<rfloor>"
proof -
{
  fix w
  {
    fix g
    {
      assume "G\<^sup>A g w"
      hence 1: "\<forall>Y. (\<P> Y w) \<longleftrightarrow> (\<^bold>\<box>(Y g)) w" by simp
      {
        fix Q
        from 1 have 2: "(\<P> Q w) \<longleftrightarrow> (\<^bold>\<box>(Q g)) w" by (rule allE)
        have  "(\<^bold>\<box>(Q g)) w \<longleftrightarrow> (G\<^sup>A \<Rrightarrow> Q) w" \<comment> \<open>we need to prove @{text "\<rightarrow>"} and @{text "\<leftarrow>"}\<close>
        proof
            assume "(\<^bold>\<box>(Q g)) w" \<comment> \<open>suppose g is God-like and necessarily has Q\<close>
            hence 3: "(\<P> Q w)" using 2 by simp \<comment> \<open>then Q is positive\<close>

            {
              fix u
              have "(\<P> Q u) \<longrightarrow> (\<forall>x. G\<^sup>A x u \<longrightarrow> (\<^bold>\<box>(Q x)) u)"
                by auto \<comment> \<open>using the definition of God-like\<close>
              have "(\<P> Q u) \<longrightarrow> (\<forall>x. G\<^sup>A x u \<longrightarrow> ((Q x)) u)"
                using refl by auto \<comment> \<open>and using @{text "\<box>(\<phi> x) \<longrightarrow> \<phi> x"}\<close>
            }
            hence "\<forall>z. (\<P> Q z) \<longrightarrow> (\<forall>x. G\<^sup>A x z \<longrightarrow> Q x z)" by (rule allI)
            hence "\<lfloor>\<P> Q \<^bold>\<rightarrow> (\<^bold>\<forall>x. G\<^sup>A x \<^bold>\<rightarrow> Q x)\<rfloor>"
              by auto \<comment> \<open>if Q is positive, then whatever is God-like has Q\<close>
            hence "\<lfloor>\<^bold>\<box>(\<P> Q \<^bold>\<rightarrow> (\<^bold>\<forall>x. G\<^sup>A x \<^bold>\<rightarrow> Q x))\<rfloor>" by (rule NEC)

            hence "\<lfloor>(\<^bold>\<box>(\<P> Q)) \<^bold>\<rightarrow> \<^bold>\<box>(\<^bold>\<forall>x. G\<^sup>A x \<^bold>\<rightarrow> Q x)\<rfloor>" using K by auto
            hence "\<lfloor>(\<^bold>\<box>(\<P> Q)) \<^bold>\<rightarrow> G\<^sup>A \<Rrightarrow> Q\<rfloor>" by simp
            hence "((\<^bold>\<box>(\<P> Q)) \<^bold>\<rightarrow> G\<^sup>A \<Rrightarrow> Q) w" by (rule allE)
            hence 4: "(\<^bold>\<box>(\<P> Q)) w \<longrightarrow> (G\<^sup>A \<Rrightarrow> Q) w" by simp (*if a property is necessarily positive, then it is entailed by being God-like*)
            have "\<lfloor>\<^bold>\<forall>X. \<P> X \<^bold>\<rightarrow> \<^bold>\<box>(\<P> X)\<rfloor>" by (rule A4a) \<comment> \<open>using axiom 4\<close>
            hence "(\<^bold>\<forall>X. \<P> X \<^bold>\<rightarrow> (\<^bold>\<box>(\<P> X))) w" by (rule allE)
            hence "\<P> Q w \<longrightarrow> (\<^bold>\<box>(\<P> Q)) w" by (rule allE)
            hence "\<P> Q w \<longrightarrow> (G\<^sup>A \<Rrightarrow> Q) w" using 4 by simp (*if Q is positive, then it is entailed by being God-like*)
            thus "(G\<^sup>A \<Rrightarrow> Q) w" using 3 by (rule mp) \<comment> \<open>@{text "\<rightarrow>"} direction\<close>
         next
           assume 5: "(G\<^sup>A \<Rrightarrow> Q) w" \<comment> \<open>suppose Q is entailed by being God-like\<close>
           have "\<lfloor>\<^bold>\<forall>X Y. (\<P> X \<^bold>\<and> (X \<Rrightarrow> Y)) \<^bold>\<rightarrow> \<P> Y\<rfloor>" by (rule A2)
           hence "(\<^bold>\<forall>X Y. (\<P> X \<^bold>\<and> (X \<Rrightarrow> Y)) \<^bold>\<rightarrow> \<P> Y) w" by (rule allE)
           hence "\<forall>X Y. (\<P> X w \<and> (X \<Rrightarrow> Y) w) \<longrightarrow> \<P> Y w" by simp
           hence "\<forall>Y. (\<P> G\<^sup>A w \<and> (G\<^sup>A \<Rrightarrow> Y) w) \<longrightarrow> \<P> Y w" by (rule allE)
           hence 6: "(\<P> G\<^sup>A w \<and> (G\<^sup>A \<Rrightarrow> Q) w) \<longrightarrow> \<P> Q w" by (rule allE)
           have "\<lfloor>\<P> G\<^sup>A\<rfloor>" by (rule T2)
           hence "\<P> G\<^sup>A w" by (rule allE)
           hence "\<P> G\<^sup>A w \<and> (G\<^sup>A \<Rrightarrow> Q) w" using 5 by (rule conjI)
           from 6 this have "\<P> Q w" by (rule mp) \<comment> \<open>Q is positive by A2 and T2\<close>
           thus "(\<^bold>\<box>(Q g)) w" using 2 by simp (*@{text "\<leftarrow>"} direction *)
         qed
     }
     hence  "\<forall>Z. (\<^bold>\<box>(Z g)) w \<longleftrightarrow> (G\<^sup>A \<Rrightarrow> Z) w" by (rule allI)
     hence "(\<^bold>\<forall>Z. \<^bold>\<box>(Z g) \<^bold>\<leftrightarrow>  G\<^sup>A \<Rrightarrow> Z) w" by simp
     hence "\<E>\<^sup>A G\<^sup>A g w" by simp
    }
    hence "G\<^sup>A g w  \<longrightarrow> \<E>\<^sup>A G\<^sup>A g w " by (rule impI)
  }
  hence "\<forall>x. G\<^sup>A x w  \<longrightarrow> \<E>\<^sup>A G\<^sup>A x w "  by (rule allI)
}
 thus ?thesis by (rule allI)
qed

text\<open>  Axiom 11.37 (Anderson's version of 11.25) \<close>
axiomatization where
 A5: "\<lfloor>\<P> NE\<^sup>A\<rfloor>"

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

text\<open>  Theorem 11.38 - Possibilist existence of God implies necessary actualist existence:  \<close>
theorem GodExistenceImpliesNecExistence: "\<lfloor>\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow>  \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>"
proof -
{
  fix w
  {
    assume "\<exists>x. G\<^sup>A x w"
    then obtain g where 1: "G\<^sup>A g w" ..
    hence "NE\<^sup>A g w" using A5 by blast                  \<comment> \<open>axiom 11.25\<close>
    hence "\<forall>Y. (\<E>\<^sup>A Y g w) \<longrightarrow> (\<^bold>\<box>\<^bold>\<exists>\<^sup>E Y) w" by simp
    hence 2: "(\<E>\<^sup>A G\<^sup>A g w) \<longrightarrow> (\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A) w" by (rule allE)
    have  "(\<^bold>\<forall>x. G\<^sup>A x \<^bold>\<rightarrow> (\<E>\<^sup>A G\<^sup>A x)) w" using GodIsEssential
      by (rule allE) \<comment> \<open>GodIsEssential follows from Axioms 11.11 and 11.3B\<close>
    hence  "(G\<^sup>A g \<^bold>\<rightarrow> (\<E>\<^sup>A G\<^sup>A g)) w" by (rule allE)
    hence  "G\<^sup>A g w \<longrightarrow> \<E>\<^sup>A G\<^sup>A g w"  by blast
    from this 1 have 3: "\<E>\<^sup>A G\<^sup>A g w" by (rule mp)
    from 2 3 have "(\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A) w" by (rule mp)
  }
  hence "(\<exists>x. G\<^sup>A x w) \<longrightarrow> (\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A) w" by (rule impI)
  hence "((\<^bold>\<exists>x. G\<^sup>A x) \<^bold>\<rightarrow>  \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A) w" by simp
}
 thus ?thesis by (rule allI)
qed

text\<open>  Some useful rules: \<close>
lemma modal_distr: "\<lfloor>\<^bold>\<box>(\<phi> \<^bold>\<rightarrow> \<psi>)\<rfloor> \<Longrightarrow> \<lfloor>(\<^bold>\<diamond>\<phi> \<^bold>\<rightarrow> \<^bold>\<diamond>\<psi>)\<rfloor>" by blast
lemma modal_trans: "(\<lfloor>\<phi> \<^bold>\<rightarrow> \<psi>\<rfloor> \<and> \<lfloor>\<psi> \<^bold>\<rightarrow> \<chi>\<rfloor>) \<Longrightarrow> \<lfloor>\<phi> \<^bold>\<rightarrow> \<chi>\<rfloor>" by simp

text\<open>  Anderson's version of Theorem 11.27  \<close>
theorem possExistenceImpliesNecEx: "\<lfloor>\<^bold>\<diamond>\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" \<comment> \<open>local consequence\<close>
proof -
  have "\<lfloor>\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" using GodExistenceImpliesNecExistence
    by simp \<comment> \<open>follows from Axioms 11.11, 11.25 and 11.3B\<close>
  hence "\<lfloor>\<^bold>\<box>(\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A)\<rfloor>" using NEC by simp
  hence 1: "\<lfloor>\<^bold>\<diamond>\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<diamond>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" by (rule modal_distr)
  have 2: "\<lfloor>\<^bold>\<diamond>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" using symm tran by metis
  from 1 2 have "\<lfloor>\<^bold>\<diamond>\<^bold>\<exists> G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<diamond>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor> \<and> \<lfloor>\<^bold>\<diamond>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" by simp
  thus ?thesis by (rule modal_trans)
qed

lemma T4: "\<lfloor>\<^bold>\<diamond>\<^bold>\<exists> G\<^sup>A\<rfloor> \<longrightarrow> \<lfloor>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" using possExistenceImpliesNecEx
    by (rule localImpGlobalCons) \<comment> \<open>global consequence\<close>

text\<open>  Conclusion - Necessary (actualist) existence of God:  \<close>
lemma GodNecExists: "\<lfloor>\<^bold>\<box>\<^bold>\<exists>\<^sup>E G\<^sup>A\<rfloor>" using T3 T4 by metis

subsection \<open>Modal Collapse\<close>

text\<open>  Modal collapse is countersatisfiable  \<close>
lemma "\<lfloor>\<^bold>\<forall>\<Phi>.(\<Phi> \<^bold>\<rightarrow> (\<^bold>\<box> \<Phi>))\<rfloor>" nitpick oops

text\<open>  \pagebreak \<close>

section \<open>Conclusion\<close>
text\<open>  We presented a shallow semantical embedding in Isabelle/HOL for an intensional higher-order modal logic
(a successor of Montague/Gallin intensional logics) as introduced by M. Fitting in his textbook \emph{Types, Tableaus and
G\"odel's God} @{cite "Fitting"}.
We subsequently employed this logic to formalise and verify all results (theorems, examples and exercises) relevant
to the discussion of G\"odel's ontological argument in the last part of Fitting's book. Three different versions of
the ontological argument have been considered: the first one by G\"odel himself (respectively, Scott), the second
one by Fitting and the last one by Anderson. \<close>

text\<open> By employing an interactive theorem-prover like Isabelle, we were not only able to verify Fitting's results,
but also to guarantee consistency. We could prove even stronger versions
of many of the theorems and find better countermodels (i.e. with smaller cardinality) than the ones presented in the book.
Another interesting aspect was the possibility to explore the implications of alternative formalisations
for definitions and theorems which shed light on interesting philosophical issues concerning entailment,
essentialism and free will, which are currently the subject of some follow-up analysis. \<close>

text\<open> The latest developments in \emph{automated theorem proving} allow us to engage in much more experimentation
during the formalisation and assessment of arguments than ever before. The potential reduction (of several orders of magnitude)
in the time needed for proving or disproving theorems (compared to pen-and-paper proofs), results in almost real-time
feedback about the suitability of our speculations. The practical benefits of computer-supported argumentation go beyond
mere quantitative (easier, faster and more reliable proofs). The advantages are also qualitative, since it fosters a
different approach to argumentation: We can now work iteratively (by `trial-and-error') on an argument
by making gradual adjustments to its definitions, axioms and theorems. This allows us to continuously expose and revise
the assumptions we indirectly commit ourselves everytime we opt for some particular formalisation.
\pagebreak
 \<close>
(*<*)
end
(*>*)


theory Ex1_2
  imports Main
begin

primrec replace :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "replace _ _ [] = []"|
  "replace old new (x # xs) = (if x = old then new else x) # replace old new xs"

theorem helper1 : "replace x y (xs @ ys) =  replace x y xs @ replace x y ys" by (induct xs, auto)

theorem "rev (replace x y zs) = replace x y (rev zs)" by (induct zs, auto simp add : helper1)

(* theorem "replace x y (replace u v zs) = replace u v (replace x y zs)" quickcheck *)

theorem "replace  a\<^sub>1 a\<^sub>2 (replace a\<^sub>2  a\<^sub>1 [a\<^sub>1]) = replace a\<^sub>2  a\<^sub>1 (replace  a\<^sub>1 a\<^sub>2 [a\<^sub>1]) \<Longrightarrow> a\<^sub>1 \<noteq> a\<^sub>2  \<Longrightarrow> False " by simp

(* theorem "replace y z (replace x y zs) = replace x z zs" quickcheck *)

theorem "replace y z (replace x y [y]) = replace x z [y] \<Longrightarrow> x \<noteq> y \<and> y \<noteq> z \<and> x \<noteq> z \<Longrightarrow> False" by auto

primrec del1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "del1 _ [] = []"|
  "del1 val (x # xs) = (if val = x then xs else x # del1 val xs)"

primrec delall:: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
  "delall _ [] = []"|
  "delall val (x#xs) = (if val = x then delall val xs else x # delall val xs)"

theorem helper2 : "del1 x (delall x xs) = delall x xs" by (induct xs, auto)

theorem "delall x (delall x xs) = delall x xs" by (induct xs , auto)

theorem "delall x (del1 x xs) = delall x xs" by (induct xs , auto)

theorem "del1 x (del1  y zs) = del1 y (del1 x zs)" by (induct zs , auto)

theorem "delall x (del1 y zs) = del1 y (delall x zs)"
proof (induct zs)
  case Nil
  then show ?case by simp
next
  case (Cons a zs)
  assume a:"delall x (del1 y zs) = del1 y (delall x zs)"
  show ?case by (metis a del1.simps(2) delall.simps(2) helper2)
qed
(*without metis*)

theorem "delall x (del1 y zs) = del1 y (delall x zs)"
proof (induct zs)
  case Nil
  then show ?case by simp
next
  case (Cons a zs)
  assume a:"delall x (del1 y zs) = del1 y (delall x zs)"
  show ?case
  proof (cases "y = a"; cases "x = a")
    assume h1:"y = a"
       and h2:"x = a"
    hence tmp:"y = x" by simp
    have "delall x (del1 y (a # zs)) = delall x zs" by (simp add : h1)
    also have "\<dots> = del1 x (delall x zs)" by (simp add : helper2)
    also have "\<dots> = del1 x (delall x (a#zs))" by (simp add : h2)
    finally show ?thesis using a by (simp add : tmp)
  next
    assume h1:"y = a"
       and h2:"x \<noteq> a"
    with a show ?thesis by simp
  next
    assume h1:"y \<noteq> a"
       and h2:"x = a"
    with a show ?thesis by simp
  next
    assume h1:"y \<noteq> a"
       and h2:"x \<noteq> a"
    with a show ?thesis by simp
  qed
qed

theorem "delall x (delall y zs) = delall y (delall x zs)" by (induct zs , auto)

(* theorem "del1 y (replace x y xs) = del1 x xs" quickcheck *)

theorem "del1 y (replace x y [x , x]) = del1 x [x , x] \<Longrightarrow> x \<noteq> y \<Longrightarrow> False" by simp

(*theorem "delall y (replace x y xs) = delall x xs" quickcheck *)

theorem "delall y (replace x y [y])  = delall x [y] \<Longrightarrow> x \<noteq> y \<Longrightarrow> False" by simp

theorem "replace x y (delall x zs) = delall x zs" by (induct zs, auto)

(*theorem "replace x y (delall z zs) = delall z (replace x y zs)" quickcheck *)

theorem "replace x y (delall x [x]) = delall x (replace x y [x]) \<Longrightarrow> y \<noteq> x \<Longrightarrow> False" by simp

(*theorem "rev (del1 x xs) = del1 x (rev xs)" quickcheck *)

theorem "ls = [x , y , x, y] \<Longrightarrow> rev (del1 x ls) = del1 x (rev ls) \<Longrightarrow> x \<noteq> y \<Longrightarrow> False" by simp

theorem helper3 : "delall x (xs @ ys) = delall x xs @ delall x ys" by (induct xs , auto)

theorem "rev (delall x xs) = delall x (rev xs)" by (induct xs, auto simp add : helper3)


(*
  File: Real.thy
  Author: Bohua Zhan

  Construction of the real numbers. This construction (starting from
  Sequence.thy and SeqRing.thy) roughly follows that in the Isabelle/HOL
  library.
*)

theory Real
  imports CompleteOrder Auto2_FOL.Rat OrderTopology
begin

section \<open>Real numbers as a quotient set\<close>

abbreviation seq_ring_rat :: i where
  "seq_ring_rat \<equiv> seq_ring(\<rat>)"
notation seq_ring_rat ("S")

definition cauchy_seqs :: i where [rewrite]:
  "cauchy_seqs = {X \<in>. S. cauchy(X)}"

lemma cauchy_seqsI [forward]: "cauchy(X) \<Longrightarrow> X \<in> seqs(\<rat>) \<Longrightarrow> X \<in> cauchy_seqs" by auto2
lemma cauchy_seqs_iff [rewrite]: "X \<in> cauchy_seqs \<longleftrightarrow> (cauchy(X) \<and> X \<in> seqs(\<rat>))" by auto2
setup {* del_prfstep_thm @{thm cauchy_seqs_def} *}

definition real_rel :: i where [rewrite]:
  "real_rel = Equiv(cauchy_seqs, \<lambda>X Y. vanishes(X -\<^sub>S Y))"
notation real_rel ("\<R>")

lemma real_rel_sym [resolve]:
  "X \<in>. S \<Longrightarrow> Y \<in>. S \<Longrightarrow> vanishes(X -\<^sub>S Y) \<Longrightarrow> vanishes(Y -\<^sub>S X)"
@proof @have "Y -\<^sub>S X = -\<^sub>S (X -\<^sub>S Y)" @qed

lemma real_rel_trans [backward2]:
  "X \<in>. S \<Longrightarrow> Y \<in>. S \<Longrightarrow> Z \<in>. S \<Longrightarrow>
   vanishes(X -\<^sub>S Y) \<Longrightarrow> vanishes(Y -\<^sub>S Z) \<Longrightarrow> vanishes(X -\<^sub>S Z)"
@proof @have "X -\<^sub>S Z = (X -\<^sub>S Y) +\<^sub>S (Y -\<^sub>S Z)" @qed

lemma real_rel_is_rel [typing]: "\<R> \<in> equiv_space(cauchy_seqs)" by auto2
setup {* fold del_prfstep_thm [@{thm real_rel_sym}, @{thm real_rel_trans}] *}

lemma real_rel_eval:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> X \<sim>\<^sub>\<R> Y \<longleftrightarrow> vanishes(X -\<^sub>S Y)" by auto2
setup {* add_rewrite_rule_cond @{thm real_rel_eval} [with_cond "?X \<noteq> ?Y"] *}
setup {* del_prfstep_thm @{thm real_rel_def} *}

definition real :: i where real_def [rewrite_bidir]:
  "real = cauchy_seqs // \<R>"

abbreviation Real :: "i \<Rightarrow> i" where "Real(X) \<equiv> equiv_class(\<R>,X)"

section \<open>Real numbers as a ring\<close>

definition nonneg_real :: "i \<Rightarrow> o" where [rewrite]:
  "nonneg_real(x) \<longleftrightarrow> nonneg_seq(rep(\<R>,x))"

definition nonneg_reals :: i where [rewrite]:
  "nonneg_reals = {x\<in>real. nonneg_real(x)}"

lemma nonneg_reals_in_real: "nonneg_reals \<subseteq> real" by auto2
setup {* add_forward_prfstep_cond @{thm nonneg_reals_in_real} [with_term "nonneg_reals"] *}

definition real_ring :: i where [rewrite]:
  "real_ring = Ring(real, Real(\<zero>\<^sub>S), \<lambda>x y. Real(rep(\<R>,x) +\<^sub>S rep(\<R>,y)),
                          Real(\<one>\<^sub>S), \<lambda>x y. Real(rep(\<R>,x) *\<^sub>S rep(\<R>,y)))"

lemma real_ring_is_ring_raw [forward]: "ring_form(real_ring)" by auto2

definition real_ord_ring :: i where [rewrite]:
  "real_ord_ring = ord_ring_from_nonneg(real_ring, nonneg_reals)"

definition real_ord_ring_top :: i  ("\<real>") where [rewrite]:
  "\<real> = ord_ring_top_from_ord_ring(real_ord_ring)"

lemma real_is_ring_raw [forward]: "is_ring_raw(\<real>)" by auto2
lemma real_carrier [rewrite_bidir]: "carrier(\<real>) = real" by auto2
lemma real_evals [rewrite]:
  "\<zero>\<^sub>\<real> = Real(\<zero>\<^sub>S)"
  "\<one>\<^sub>\<real> = Real(\<one>\<^sub>S)"
  "x \<in>. \<real> \<Longrightarrow> y \<in>. \<real> \<Longrightarrow> x +\<^sub>\<real> y = Real(rep(\<R>,x) +\<^sub>S rep(\<R>,y))"
  "x \<in>. \<real> \<Longrightarrow> y \<in>. \<real> \<Longrightarrow> x *\<^sub>\<real> y = Real(rep(\<R>,x) *\<^sub>S rep(\<R>,y))"
  "x \<in>. \<real> \<Longrightarrow> y \<in>. \<real> \<Longrightarrow> is_abgroup(\<real>) \<Longrightarrow> x \<le>\<^sub>\<real> y \<longleftrightarrow> y -\<^sub>\<real> x \<in> nonneg_reals" by auto2+

setup {* register_wellform_data ("nonneg_compat(R,A)", ["A \<subseteq> carrier(R)"]) *}

lemma nonneg_compat_prop [forward]:
  "is_ring_raw(R) \<Longrightarrow> is_ring(T) \<Longrightarrow> A \<subseteq> carrier(R) \<Longrightarrow> eq_str_ring(R,T) \<Longrightarrow>
   nonneg_compat(R,A) \<Longrightarrow> nonneg_compat(T,A)" by auto2

lemma real_is_ord_field_prep [forward]:
  "is_field(\<real>) \<Longrightarrow> nonneg_compat(\<real>,nonneg_reals) \<Longrightarrow> is_ord_field(\<real>)" by auto2

lemma ord_ring_card_ge2 [forward]:
  "is_ord_ring(R) \<Longrightarrow> card_ge2(carrier(R))"
@proof @have "{\<zero>\<^sub>R,\<one>\<^sub>R} \<subseteq> carrier(R)" @qed

lemma real_is_order_top_prep [backward]:
  "is_ord_ring(\<real>) \<Longrightarrow> order_topology(\<real>)" by auto2
setup {* fold del_prfstep_thm [@{thm real_ring_def}, @{thm real_ord_ring_def}, @{thm real_ord_ring_top_def}] *}

lemma seq_const_in_cauchy_seqs [typing]: "r \<in>. \<rat> \<Longrightarrow> {r}\<^sub>\<rat> \<in>. \<R>" by auto2

lemma real_choose_rep: "x \<in>. \<real> \<Longrightarrow> x = Real(rep(\<R>,x))" by auto2
setup {* add_rewrite_rule_cond @{thm real_choose_rep} [with_filt (size1_filter "x")] *}

section \<open>Addition on real numbers\<close>

lemma real_add_eval [rewrite]:
  "x \<in>. \<R> \<Longrightarrow> y \<in>. \<R> \<Longrightarrow> Real(x) +\<^sub>\<real> Real(y) = Real(x +\<^sub>S y)"
@proof @have "compat_meta_bin(\<R>, \<lambda>X Y. X +\<^sub>S Y)" @qed
setup {* del_prfstep_thm @{thm real_evals(3)} *}

lemma real_add_comm [forward]: "is_plus_comm(\<real>)" by auto2
lemma real_add_assoc [forward]: "is_plus_assoc(\<real>)" by auto2

section \<open>Multiplication on real numbers\<close>

lemma real_mult_eval [rewrite]:
  "x \<in>. \<R> \<Longrightarrow> y \<in>. \<R> \<Longrightarrow> Real(x) *\<^sub>\<real> Real(y) = Real(x *\<^sub>S y)"
@proof
  @have "\<forall>X Y Z. X \<in>. \<R> \<longrightarrow> Y \<sim>\<^sub>\<R> Z \<longrightarrow> X *\<^sub>S Y \<sim>\<^sub>\<R> X *\<^sub>S Z" @with
    @have "X *\<^sub>S Y -\<^sub>S X *\<^sub>S Z = X *\<^sub>S (Y -\<^sub>S Z)"
  @end
  @have "\<forall>X Y Z. X \<in>. \<R> \<longrightarrow> Y \<sim>\<^sub>\<R> Z \<longrightarrow> Y *\<^sub>S X \<sim>\<^sub>\<R> Z *\<^sub>S X" @with
    @have "Y *\<^sub>S X -\<^sub>S Z *\<^sub>S X = (Y -\<^sub>S Z) *\<^sub>S X"
  @end
  @have "compat_meta_bin(\<R>, \<lambda>X Y. X *\<^sub>S Y)"
@qed
setup {* del_prfstep_thm @{thm real_evals(4)} *}

lemma real_mult_comm [forward]: "is_times_comm(\<real>)" by auto2
lemma real_mult_assoc [forward]: "is_times_assoc(\<real>)" by auto2
lemma real_distrib_l [forward]: "is_left_distrib(\<real>)" by auto2

section \<open>0 and 1\<close>

lemma real_is_add_id [forward]: "is_add_id(\<real>)" by auto2
lemma real_is_mult_id [forward]: "is_mult_id(\<real>)" by auto2
lemma real_zero_neq_one [resolve]: "\<zero>\<^sub>\<real> \<noteq> \<one>\<^sub>\<real>" by auto2

section \<open>Negation on real numbers\<close>

lemma real_is_comm_ring [forward]: "is_comm_ring(\<real>)"
@proof @have "\<forall>x\<in>.\<real>. x +\<^sub>\<real> Real(-\<^sub>S rep(\<R>,x)) = \<zero>\<^sub>\<real>" @qed

section \<open>Inverse in real numbers\<close>

lemma real_is_field [forward]: "is_field(\<real>)"
@proof @have "\<forall>x\<in>.\<real>. x \<noteq> \<zero>\<^sub>\<real> \<longrightarrow> x *\<^sub>\<real> Real(seq_inverse(rep(\<R>,x))) = \<one>\<^sub>\<real>" @qed

section \<open>Nonnegative real numbers\<close>

lemma real_neg_eval [rewrite]: "x \<in>. \<R> \<Longrightarrow> -\<^sub>\<real> Real(x) = Real(-\<^sub>S x)"
@proof @have "Real(x) +\<^sub>\<real> Real(-\<^sub>S x) = \<zero>\<^sub>\<real>" @qed

lemma nonneg_real_eval [rewrite]:
  "x \<in>. \<R> \<Longrightarrow> nonneg_real(Real(x)) \<longleftrightarrow> nonneg_seq(x)" by auto2
setup {* del_prfstep_thm @{thm nonneg_real_def} *}

lemma real_is_ord_field [forward]: "is_ord_field(\<real>)"
@proof
  @have "nonneg_compat(\<real>, nonneg_reals)" @with
    @have "subset_add_closed(\<real>, nonneg_reals)"
    @have "subset_mult_closed(\<real>, nonneg_reals)"
  @end
@qed
setup {* del_prfstep_thm @{thm real_is_ord_field_prep} *}

section \<open>of\_nat, of\_int, of\_rat in terms of sequences\<close>

lemma real_of_nat [rewrite]:
  "n \<in> nat \<Longrightarrow> of_nat(\<real>,n) = Real({of_nat(\<rat>,n)}\<^sub>\<rat>)"
@proof @var_induct "n \<in> nat" @qed

lemma real_diff_eval [rewrite]:
  "x \<in>. \<R> \<Longrightarrow> y \<in>. \<R> \<Longrightarrow> Real(x) -\<^sub>\<real> Real(y) = Real(x -\<^sub>S y)"
@proof @have "Real(x) -\<^sub>\<real> Real(y) = Real(x) +\<^sub>\<real> (-\<^sub>\<real> Real(y))" @qed

lemma real_diff_eval_seq [rewrite]:
  "r \<in>. \<rat> \<Longrightarrow> s \<in>. \<rat> \<Longrightarrow> Real({r}\<^sub>\<rat>) -\<^sub>\<real> Real({s}\<^sub>\<rat>) = Real({r -\<^sub>\<rat> s}\<^sub>\<rat>)" by auto2

lemma real_inv_eval [rewrite]:
  "r \<in> units(\<rat>) \<Longrightarrow> inv(\<real>,Real({r}\<^sub>\<rat>)) = Real({inv(\<rat>,r)}\<^sub>\<rat>)"
@proof @have "Real({r}\<^sub>\<rat>) *\<^sub>\<real> Real({inv(\<rat>,r)}\<^sub>\<rat>) = \<one>\<^sub>\<real>" @qed

lemma real_mult_eval_seq [rewrite]:
  "r \<in>. \<rat> \<Longrightarrow> s \<in>. \<rat> \<Longrightarrow> Real({r}\<^sub>\<rat>) *\<^sub>\<real> Real({s}\<^sub>\<rat>) = Real({r *\<^sub>\<rat> s}\<^sub>\<rat>)" by auto2

lemma real_divide_eval [rewrite]:
  "r \<in>. \<rat> \<Longrightarrow> s \<in> units(\<rat>) \<Longrightarrow> Real({r}\<^sub>\<rat>) /\<^sub>\<real> Real({s}\<^sub>\<rat>) = Real({r /\<^sub>\<rat> s}\<^sub>\<rat>)"
@proof
  @have "Real({r}\<^sub>\<rat>) /\<^sub>\<real> Real({s}\<^sub>\<rat>) = Real({r}\<^sub>\<rat>) *\<^sub>\<real> inv(\<real>,Real({s}\<^sub>\<rat>))"
  @have "r /\<^sub>\<rat> s = r *\<^sub>\<rat> inv(\<rat>,s)"
@qed

lemma real_of_int [rewrite]:
  "z \<in>. \<int> \<Longrightarrow> of_int(\<real>,z) = Real({of_int(\<rat>,z)}\<^sub>\<rat>)"
@proof @obtain "a\<in>.\<nat>" "b\<in>.\<nat>" where "z = of_nat(\<int>,a) -\<^sub>\<int> of_nat(\<int>,b)" @qed

lemma of_rat_divide [rewrite_bidir]:
  "is_ord_field(R) \<Longrightarrow> x \<in>. \<rat> \<Longrightarrow> y \<in> units(\<rat>) \<Longrightarrow> of_rat(R,x /\<^sub>\<rat> y) = of_rat(R,x) /\<^sub>R of_rat(R,y)"
@proof
  @have "of_rat(R,x) /\<^sub>R of_rat(R,y) = of_rat(R,x) *\<^sub>R inv(R,of_rat(R,y))"
@qed

lemma real_of_rat [backward]:
  "r \<in>. \<rat> \<Longrightarrow> of_rat(\<real>,r) = Real({r}\<^sub>\<rat>)"
@proof
  @obtain "a\<in>.\<int>" b where "b>\<^sub>\<int>0\<^sub>\<int>" "r = of_int(\<rat>,a) /\<^sub>\<rat> of_int(\<rat>,b)"
@qed

setup {* fold del_prfstep_thm [@{thm real_of_nat}, @{thm real_of_int}] *}
setup {* del_prfstep_thm @{thm real_choose_rep} *}

section \<open>Ordering on real numbers\<close>

lemma le_Real1 [rewrite]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> Real(X) \<le>\<^sub>\<real> Real(Y) \<longleftrightarrow> nonneg_seq(Y -\<^sub>S X)" by auto2
setup {* fold del_prfstep_thm [@{thm real_evals(5)}, @{thm nonneg_real_eval}, @{thm nonneg_reals_def}] *}

lemma le_Real [rewrite]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> Real(X) \<le>\<^sub>\<real> Real(Y) \<longleftrightarrow> (\<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> r)"
@proof @have "Y -\<^sub>S X = -\<^sub>S (X -\<^sub>S Y)" @qed
setup {* del_prfstep_thm @{thm le_Real1} *}

lemma le_RealI [resolve]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> \<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> r \<Longrightarrow> Real(X) \<le>\<^sub>\<real> Real(Y)" by auto2

lemma le_RealD [backward2]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> Real(X) \<le>\<^sub>\<real> Real(Y) \<Longrightarrow> r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<Longrightarrow> \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> r" by auto2
setup {* del_prfstep_thm @{thm le_Real} *}

lemma le_Real_all_n [resolve]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> \<forall>n\<in>.\<nat>. X`n \<le>\<^sub>\<rat> Y`n \<Longrightarrow> Real(X) \<le>\<^sub>\<real> Real(Y)"
@proof
  @have "\<forall>r. r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<longrightarrow> (\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> r)" @with
    @have "\<forall>n\<ge>\<^sub>\<nat>0. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> r" @end
@qed

lemma archimedeal_Real [forward]: "is_archimedean(\<real>)"
@proof
  @have "\<forall>x>\<^sub>\<real>0\<^sub>\<real>. \<exists>r\<in>.\<rat>. of_rat(\<real>,r) \<ge>\<^sub>\<real> x" @with
    @let "X = rep(\<R>,x)"
    @obtain b where "b >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "\<forall>n\<in>.\<nat>. \<bar>X`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> b"
    @have "of_rat(\<real>,b) = Real({b}\<^sub>\<rat>)"
    @have "\<forall>n\<in>.\<nat>. X`n \<le>\<^sub>\<rat> {b}\<^sub>\<rat>`n"
  @end
@qed

lemma le_rat_real [backward1]:
  "X \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<Longrightarrow> Real(X) \<le>\<^sub>\<real> of_rat(\<real>,c) \<Longrightarrow> \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. X`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
@proof
  @have "of_rat(\<real>,c) = Real({c}\<^sub>\<rat>)"
  @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S {c}\<^sub>\<rat>)`n \<le>\<^sub>\<rat> r"
  @have "\<forall>n\<ge>\<^sub>\<nat>k. X`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @with @have "X`n -\<^sub>\<rat> c \<le>\<^sub>\<rat> r" @end
@qed

lemma diff_le_rat_real2 [backward1]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<Longrightarrow> Real(X) -\<^sub>\<real> Real(Y) \<le>\<^sub>\<real> of_rat(\<real>,c) \<Longrightarrow>
   \<exists>k\<in>.\<nat>. \<forall>m\<ge>\<^sub>\<nat>k. \<forall>n\<ge>\<^sub>\<nat>k. X`m -\<^sub>\<rat> Y`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
@proof
  @obtain s t where "s >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "t >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "r = s +\<^sub>\<rat> t"
  @obtain "i\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>i. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> s"
  @obtain j where "j\<ge>\<^sub>\<nat>i" "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. \<bar>X`m -\<^sub>\<rat> X`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> t"
  @have "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. X`m -\<^sub>\<rat> Y`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @with
    @have "\<bar>X`m -\<^sub>\<rat> X`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> t"
    @have "X`m -\<^sub>\<rat> Y`n = (X`m -\<^sub>\<rat> X`n) +\<^sub>\<rat> (X`n -\<^sub>\<rat> Y`n)"
    @have "t +\<^sub>\<rat> (c +\<^sub>\<rat> s) = c +\<^sub>\<rat> (s +\<^sub>\<rat> t)" @end
@qed

lemma abs_diff_le_rat_real2D [backward1]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<Longrightarrow> \<bar>Real(X) -\<^sub>\<real> Real(Y)\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,c) \<Longrightarrow>
   \<exists>k\<in>.\<nat>. \<forall>m\<ge>\<^sub>\<nat>k. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`m -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
@proof
  @obtain "i\<in>.\<nat>" where "\<forall>m\<ge>\<^sub>\<nat>i. \<forall>n\<ge>\<^sub>\<nat>i. X`m -\<^sub>\<rat> Y`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @with
    @have "Real(X) -\<^sub>\<real> Real(Y) \<le>\<^sub>\<real> of_rat(\<real>,c)" @end
  @obtain "j\<in>.\<nat>" where "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. Y`m -\<^sub>\<rat> X`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @with
    @have "Real(Y) -\<^sub>\<real> Real(X) \<le>\<^sub>\<real> of_rat(\<real>,c)" @end
  @let "k = max(\<nat>,i,j)"
  @have "\<forall>m\<ge>\<^sub>\<nat>k. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`m -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @with
    @have "X`m -\<^sub>\<rat> Y`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
    @have "Y`n -\<^sub>\<rat> X`m \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
  @end
@qed
setup {* del_prfstep_thm @{thm diff_le_rat_real2} *}

lemma le_rat_realI [resolve]:
  "X \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> \<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. X`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r \<Longrightarrow> Real(X) \<le>\<^sub>\<real> of_rat(\<real>,c)"
@proof
  @have "of_rat(\<real>,c) = Real({c}\<^sub>\<rat>)"
  @have "\<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S {c}\<^sub>\<rat>)`n \<le>\<^sub>\<rat> r" @with
    @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. X`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
    @have "\<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S {c}\<^sub>\<rat>)`n \<le>\<^sub>\<rat> r" @with @have "X`n -\<^sub>\<rat> c \<le>\<^sub>\<rat> r" @end
  @end
@qed

lemma diff_le_rat_realI [resolve]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> \<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r \<Longrightarrow>
   Real(X) -\<^sub>\<real> Real(Y) \<le>\<^sub>\<real> of_rat(\<real>,c)" by auto2
setup {* del_prfstep_thm @{thm le_rat_realI} *}

lemma abs_diff_le_rat_realI [resolve]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> \<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r \<Longrightarrow>
   \<bar>Real(X) -\<^sub>\<real> Real(Y)\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,c)"
@proof
  @have "Real(X) -\<^sub>\<real> Real(Y) \<le>\<^sub>\<real> of_rat(\<real>,c)" @with
    @have "\<forall>r. r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<longrightarrow> (\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r)" @with
      @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
      @have "\<forall>n\<ge>\<^sub>\<nat>k. (X -\<^sub>S Y)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @end @end
  @have "Real(Y) -\<^sub>\<real> Real(X) \<le>\<^sub>\<real> of_rat(\<real>,c)" @with
    @have "\<forall>r. r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<longrightarrow> (\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. (Y -\<^sub>S X)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r)" @with
      @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r"
      @have "\<forall>n\<ge>\<^sub>\<nat>k. (Y -\<^sub>S X)`n \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @end @end
@qed
setup {* del_prfstep_thm @{thm diff_le_rat_realI} *}

lemma abs_diff_le_rat_realI' [backward1]:
  "X \<in>. \<R> \<Longrightarrow> Y \<in>. \<R> \<Longrightarrow> c \<in>. \<rat> \<Longrightarrow> i \<in>. \<nat> \<Longrightarrow> \<forall>n\<ge>\<^sub>\<nat>i. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> c \<Longrightarrow>
   \<bar>Real(X) -\<^sub>\<real> Real(Y)\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,c)"
@proof
  @have "\<forall>r. r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<longrightarrow> (\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r)" @with
    @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> c"
    @have "\<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<rat> Y`n\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> c +\<^sub>\<rat> r" @end
@qed

lemma converges_to_in_rat [resolve]:
  "ord_field_seq(X) \<Longrightarrow> R = target_str(X) \<Longrightarrow> s \<in>. R \<Longrightarrow> is_archimedean(R) \<Longrightarrow>
   \<forall>r>\<^sub>\<rat>\<zero>\<^sub>\<rat>. \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>R s\<bar>\<^sub>R \<le>\<^sub>R of_rat(R,r) \<Longrightarrow> converges_to(X,s)"
@proof
  @have "\<forall>r'. r' >\<^sub>R \<zero>\<^sub>R \<longrightarrow> (\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>R s\<bar>\<^sub>R <\<^sub>R r')" @with
    @obtain r where "r >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "of_rat(R,r) <\<^sub>R r'"
    @obtain "k\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>R s\<bar>\<^sub>R \<le>\<^sub>R of_rat(R,r)" @end
@qed

section \<open>A sequence that converges to zero\<close>

definition err :: i where [rewrite]:
  "err = Seq(\<rat>, \<lambda>n. inv(\<rat>,of_nat(\<rat>,n +\<^sub>\<nat> 1)))"

lemma err_type [typing]: "err \<in> seqs(\<rat>)" by auto2

lemma err_gt_zero: "n \<in>. \<nat> \<Longrightarrow> err`n >\<^sub>\<rat> \<zero>\<^sub>\<rat>" by auto2
setup {* add_forward_prfstep_cond @{thm err_gt_zero} [with_term "err`?n"] *}

lemma err_decreasing [backward]: "m >\<^sub>\<nat> n \<Longrightarrow> err`m <\<^sub>\<rat> err`n"
@proof @have "of_nat(\<rat>,n +\<^sub>\<nat> 1) >\<^sub>\<rat> \<zero>\<^sub>\<rat>" @qed

lemma err_less_than_r [backward]: "r >\<^sub>\<rat> \<zero>\<^sub>\<rat>\<Longrightarrow> \<exists>n\<in>.\<nat>. err`n <\<^sub>\<rat> r"
@proof @obtain "n\<in>nat" where "inv(\<rat>,of_nat(\<rat>,n +\<^sub>\<nat> 1)) <\<^sub>\<rat> r" @qed

lemma err_converge_to_zero [backward]: "r >\<^sub>\<rat> \<zero>\<^sub>\<rat> \<Longrightarrow> \<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. err`n <\<^sub>\<rat> r"
@proof
  @obtain "k\<in>.\<nat>" where "err`k <\<^sub>\<rat> r"
  @have "\<forall>n\<ge>\<^sub>\<nat>k. err`n <\<^sub>\<rat> r"
@qed
setup {* del_prfstep_thm @{thm err_def} *}

section \<open>Cauchy completeness of real numbers\<close>

(* We start by defining, for each Cauchy sequence X of real numbers, a "diagonal"
   sequence for the double sequence of representatives of X. *)
definition Diag :: "i \<Rightarrow> i" where [rewrite]:
  "Diag(X) = Seq(\<rat>,\<lambda>n. rep(\<R>,X`n)`(SOME k\<in>.\<nat>. \<forall>i\<ge>\<^sub>\<nat>k. \<bar>rep(\<R>,X`n)`i -\<^sub>\<rat> rep(\<R>,X`n)`k\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n))"
setup {* register_wellform_data ("Diag(X)", ["X \<in> seqs(\<real>)"]) *}

lemma Diag_type [typing]:
  "X \<in> seqs(\<real>) \<Longrightarrow> Diag(X) \<in> seqs(\<rat>)" by auto2

lemma Diag_prop [backward]:
  "X \<in> seqs(\<real>) \<Longrightarrow> n \<in>. \<nat> \<Longrightarrow> \<exists>k\<in>.\<nat>. \<forall>i\<ge>\<^sub>\<nat>k. \<bar>rep(\<R>,X`n)`i -\<^sub>\<rat> Diag(X)`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n" by auto2

lemma Diag_prop_ge_nat [backward]:
  "X \<in> seqs(\<real>) \<Longrightarrow> n \<in>. \<nat> \<Longrightarrow> i \<in>. \<nat> \<Longrightarrow> \<exists>k\<ge>\<^sub>\<nat>i. \<forall>i\<ge>\<^sub>\<nat>k. \<bar>rep(\<R>,X`n)`i -\<^sub>\<rat> Diag(X)`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n"
@proof
  @obtain "k\<in>.\<nat>" where "\<forall>i\<ge>\<^sub>\<nat>k. \<bar>rep(\<R>,X`n)`i -\<^sub>\<rat> Diag(X)`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n"
  @have "max(\<nat>,k,i) \<ge>\<^sub>\<nat> i"
@qed
setup {* del_prfstep_thm @{thm Diag_def} *}

lemma Diag_is_cauchy [forward]:
  "cauchy(X) \<Longrightarrow> X \<in> seqs(\<real>) \<Longrightarrow> cauchy(Diag(X))"
@proof @contradiction
  @let "W = Diag(X)"
  @obtain r where "r >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "\<not>(\<exists>k\<in>.\<nat>. \<forall>m\<ge>\<^sub>\<nat>k. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>W`m -\<^sub>\<rat> W`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> r)"
  @obtain r1 r2 r3 where "r1 >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "r2 >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "r3 >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "r = r1 +\<^sub>\<rat> (r2 +\<^sub>\<rat> r3) +\<^sub>\<rat> r1" @with
    @have "r = r /\<^sub>\<rat> 4\<^sub>\<rat> +\<^sub>\<rat> (r /\<^sub>\<rat> 4\<^sub>\<rat> +\<^sub>\<rat> r /\<^sub>\<rat> 4\<^sub>\<rat>) +\<^sub>\<rat> r /\<^sub>\<rat> 4\<^sub>\<rat>" @end
  @obtain "i\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>i. err`n <\<^sub>\<rat> r1"
  @obtain j where "j\<ge>\<^sub>\<nat>i" "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. \<bar>X`m -\<^sub>\<real> X`n\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,r2)"
  @have "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. \<bar>W`m -\<^sub>\<rat> W`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> r" @with
    @let "Sm = rep(\<R>,X`m)" "Sn = rep(\<R>,X`n)"
    @obtain "k1\<in>.\<nat>" where "\<forall>k'\<ge>\<^sub>\<nat>k1. \<bar>Sm`k' -\<^sub>\<rat> W`m\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`m"
    @obtain "k2\<in>.\<nat>" where "\<forall>k'\<ge>\<^sub>\<nat>k2. \<bar>Sn`k' -\<^sub>\<rat> W`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n"
    @obtain "k3\<in>.\<nat>" where "\<forall>k'\<ge>\<^sub>\<nat>k3. \<forall>k''\<ge>\<^sub>\<nat>k3. \<bar>Sm`k' -\<^sub>\<rat> Sn`k''\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> r2 +\<^sub>\<rat> r3" @with
      @have "\<bar>X`m -\<^sub>\<real> X`n\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,r2)"
    @end
    @obtain k where "k \<ge>\<^sub>\<nat> k1" "k \<ge>\<^sub>\<nat> k2" "k \<ge>\<^sub>\<nat> k3"
    @have "\<bar>W`m -\<^sub>\<rat> Sn`k\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`m +\<^sub>\<rat> (r2 +\<^sub>\<rat> r3)" @with
      @have "\<bar>Sm`k -\<^sub>\<rat> Sn`k\<bar>\<^sub>\<rat> \<le>\<^sub>\<rat> r2 +\<^sub>\<rat> r3"
    @end
  @end
@qed

lemma Diag_converges [forward]:
  "cauchy(X) \<Longrightarrow> X \<in> seqs(\<real>) \<Longrightarrow> converges_to(X,Real(Diag(X)))"
@proof @contradiction
  @let "W = Diag(X)"
  @obtain r where "r >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "\<not>(\<exists>k\<in>.\<nat>. \<forall>n\<ge>\<^sub>\<nat>k. \<bar>X`n -\<^sub>\<real> Real(W)\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,r))"
  @obtain s t where "s >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "t >\<^sub>\<rat> \<zero>\<^sub>\<rat>" "r = s +\<^sub>\<rat> t"
  @obtain "i\<in>.\<nat>" where "\<forall>n\<ge>\<^sub>\<nat>i. err`n <\<^sub>\<rat> s"
  @obtain j where "j\<ge>\<^sub>\<nat>i" "\<forall>m\<ge>\<^sub>\<nat>j. \<forall>n\<ge>\<^sub>\<nat>j. \<bar>W`m -\<^sub>\<rat> W`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> t"
  @have "\<forall>n\<ge>\<^sub>\<nat>j. \<bar>X`n -\<^sub>\<real> Real(W)\<bar>\<^sub>\<real> \<le>\<^sub>\<real> of_rat(\<real>,r)" @with
    @let "Sn = rep(\<R>,X`n)"
    @obtain k where "k\<ge>\<^sub>\<nat>j" "\<forall>k'\<ge>\<^sub>\<nat>k. \<bar>Sn`k' -\<^sub>\<rat> W`n\<bar>\<^sub>\<rat> <\<^sub>\<rat> err`n"
    @have "\<forall>p\<ge>\<^sub>\<nat>k. \<bar>Sn`p -\<^sub>\<rat> W`p\<bar>\<^sub>\<rat> <\<^sub>\<rat> r"
  @end
@qed

lemma real_cauchy_complete [forward]: "cauchy_complete_field(\<real>)"
@proof @have "\<forall>X\<in>seqs(\<real>). cauchy(X) \<longrightarrow> converges(X)" @qed
setup {* fold del_prfstep_thm [@{thm Diag_is_cauchy}, @{thm Diag_converges}] *}
setup {* fold del_prfstep_thm [@{thm abs_diff_le_rat_real2D}, @{thm abs_diff_le_rat_realI},
  @{thm abs_diff_le_rat_realI'}, @{thm converges_to_in_rat}] *}

lemma real_continuum [forward]: "linear_continuum(\<real>)" by auto2

lemma real_order_topology [forward]: "order_topology(\<real>)" by auto2
setup {* del_prfstep_thm @{thm real_is_order_top_prep} *}

no_notation seq_ring_rat ("S")
no_notation real_rel ("\<R>")
setup {* del_prfstep_thm @{thm real_def} *}
setup {* fold del_prfstep_thm @{thms real_evals(1-2)} *}
setup {* fold del_prfstep_thm [@{thm real_add_eval}, @{thm real_mult_eval}] *}

end


(* Title:      Regular Algebras
   Author:     Simon Foster, Georg Struth
   Maintainer: Simon Foster <s.foster at york.ac.uk>
               Georg Struth <g.struth at sheffield.ac.uk>
*)

section \<open>Dioids, Powers and Finite Sums\<close>

theory Dioid_Power_Sum
  imports Kleene_Algebra.Dioid Kleene_Algebra.Finite_Suprema

begin

text \<open>We add a few facts about powers and finite
 sums---in fact, finite suprema---to an existing theory field for dioids.\<close>

context dioid_one_zero

begin

lemma add_iso_r: "y \<le> z \<Longrightarrow> x + y \<le> x + z"
    using local.join.sup_mono by blast

notation power ("_\<^bsup>_\<^esup>" [101,50] 100)

lemma power_subdist: "x\<^bsup>n\<^esup> \<le> (x + y)\<^bsup>n\<^esup>"
  apply (induct n)
  apply simp
  using local.mult_isol_var local.power_Suc2 by auto

lemma power_inductl_var: "x \<cdot> y \<le> y \<Longrightarrow> x\<^bsup>n\<^esup> \<cdot> y \<le> y"
  apply (induct n)
  apply simp
  by (metis (no_types, lifting) local.dual_order.trans local.mult_isol local.power_Suc2 mult_assoc)

lemma power_inductr_var: "y \<cdot> x \<le> y \<Longrightarrow> y \<cdot> x\<^bsup>n\<^esup> \<le> y"
  by (induct n, metis eq_refl mult_oner power.simps(1), metis mult.assoc mult_isor order_refl order_trans power.simps(2) power_commutes)

definition powsum :: "'a \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a"  ("_\<^bsub>_\<^esub>\<^bsup>_\<^esup>" [101,50,50] 100) where
  "powsum x m n = sum ((^) x) {m..n + m}"

lemmas powsum_simps = powsum_def atLeastAtMostSuc_conv numerals

lemma powsum1 [simp]: "x\<^bsub>n\<^esub>\<^bsup>0\<^esup> = x\<^bsup>n\<^esup>"
  by (simp add:powsum_simps)

lemma powsum2: "x\<^bsub>n\<^esub>\<^bsup>Suc m\<^esup> = x\<^bsub>n\<^esub>\<^bsup>m \<^esup>+ x\<^bsup>n+Suc m\<^esup>"
proof-
  have "x\<^bsub>n\<^esub>\<^bsup>Suc m\<^esup> = sum ((^) x) {n..(Suc m)+n}"
    using powsum_def by blast
  also have "... = sum ((^) x) {n..m+n} +  x\<^bsup>n+Suc m\<^esup>"
    by (simp add: ab_semigroup_add_class.add.commute atLeastAtMostSuc_conv local.join.sup_commute)
  finally show ?thesis
    by (simp add: powsum_def)
qed

lemma powsum_00 [simp]: "x\<^bsub>0\<^esub>\<^bsup>0 \<^esup>= 1"
  by (simp add: powsum_def)

lemma powsum_01 [simp]: "x\<^bsub>0\<^esub>\<^bsup>1\<^esup> = 1 + x"
  by (simp add: powsum2)

lemma powsum_10 [simp]: "x\<^bsub>1\<^esub>\<^bsup>0\<^esup> = x"
  by (simp add: powsum_simps)

lemma powsum_split: "x\<^bsub>m\<^esub>\<^bsup>i+Suc n\<^esup> = x\<^bsub>m\<^esub>\<^bsup>i\<^esup> + x\<^bsub>m+Suc i\<^esub>\<^bsup>n\<^esup>"
  by (induct n, simp_all add:powsum_simps ac_simps)

lemma powsum_split_var1: "x\<^bsub>0\<^esub>\<^bsup>n+1\<^esup> = 1 + x\<^bsub>1\<^esub>\<^bsup>n\<^esup>"
proof -
  have "x\<^bsub>0\<^esub>\<^bsup>n + 1\<^esup> = x\<^bsub>0\<^esub>\<^bsup>0 + Suc n\<^esup>"
    by simp
  also have "... = x\<^bsub>0\<^esub>\<^bsup>0\<^esup> + x\<^bsub>0 + Suc 0\<^esub>\<^bsup>n\<^esup>"
    by (subst powsum_split, rule refl)
  also have "... = 1 + x\<^bsub>0 + Suc 0\<^esub>\<^bsup>n\<^esup>"
    by simp
  finally show ?thesis
    by simp
qed

lemma powsum_split_var2 [simp]: "x\<^bsup>m\<^esup> + x\<^bsub>0\<^esub>\<^bsup>m\<^esup> = x\<^bsub>0\<^esub>\<^bsup>m\<^esup>"
proof (induct m)
  case 0 show ?case
    by (metis add_idem' power_0 powsum_00)
  case (Suc n) show ?case
    by (simp add: add_commute powsum2)
qed

lemma powsum_split_var3: "x\<^bsub>0\<^esub>\<^bsup>m+Suc n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>m \<^esup>+ x\<^bsub>0+Suc m\<^esub>\<^bsup>n\<^esup>"
  by (subst powsum_split, simp)

lemma powsum_split_var4 [simp]: "x\<^bsub>0\<^esub>\<^bsup>m+n\<^esup> + x\<^bsub>m\<^esub>\<^bsup>n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>m+n\<^esup>"
proof (induct n)
  case 0 show ?case
    by (metis add_0_iff add_comm powsum1 powsum_split_var2)
next
  case (Suc n) note hyp = this
  show ?case
  proof -
    have  "x\<^bsub>0\<^esub>\<^bsup>m + Suc n\<^esup> + x\<^bsub>m\<^esub>\<^bsup>Suc n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>m + n\<^esup> + x\<^bsup>Suc (m + n)\<^esup> + (x\<^bsub>m\<^esub>\<^bsup>n\<^esup> + x\<^bsup>m + Suc n\<^esup>)"
      by (auto simp add: powsum2)
    also have "... = (x\<^bsub>0\<^esub>\<^bsup>m + n \<^esup>+ x\<^bsub>m\<^esub>\<^bsup>n\<^esup>) + x\<^bsup>Suc (m + n)\<^esup> + x\<^bsup>m + Suc n\<^esup>"
      by (metis add.assoc add.left_commute)
    also have "... =  x\<^bsup>Suc (m+n)\<^esup> + x\<^bsub>0\<^esub>\<^bsup>m+n\<^esup>"
      by (metis add_Suc_right add.assoc add.commute add_idem' hyp)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>m + Suc n\<^esup>"
      by (simp add: add_commute powsum2)
    finally show ?thesis .
  qed
qed

lemma powsum_split_var6: "x\<^bsub>0\<^esub>\<^bsup>(Suc k)+Suc n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>Suc k \<^esup>+ x\<^bsub>0+Suc (Suc k)\<^esub>\<^bsup>n\<^esup>"
  by (metis powsum_split_var3)

lemma powsum_ext: "x \<le> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup>"
proof (induct n)
  case 0 show ?case
    by (metis One_nat_def local.join.sup_ge2 powsum_01)
next
  case (Suc n) thus ?case
    by (auto simp add:less_eq_def powsum_simps, metis (lifting, no_types) add.left_commute)
qed

lemma powsum_one: "1 \<le> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup>"
  by (induct n, metis One_nat_def local.join.sup.cobounded1 powsum_01, metis (full_types) Suc_eq_plus1 local.join.sup.cobounded1 powsum_split_var1)

lemma powsum_shift1: "x \<cdot> x\<^bsub>m\<^esub>\<^bsup>n\<^esup> = x\<^bsub>m+1\<^esub>\<^bsup>n\<^esup>"
  apply (induct n)
  apply (simp_all add: powsum_simps)
  apply (metis local.add_left_comm local.distrib_left powsum_def)
  done

lemma powsum_shift: "x\<^bsup>k \<^esup>\<cdot> x\<^bsub>m\<^esub>\<^bsup>n\<^esup> = x\<^bsub>k+m\<^esub>\<^bsup>n\<^esup>"
  by (induct k, simp_all, metis Suc_eq_plus1 mult.assoc powsum_shift1)

lemma powsum_prod_suc: "x\<^bsub>0\<^esub>\<^bsup>m \<^esup>\<cdot> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>Suc (m+n)\<^esup>"
proof (induct m)
  case 0 show ?case
    by simp
  case (Suc m)
  note hyp = this
  show ?case
  proof -
    have "x\<^bsub>0\<^esub>\<^bsup>Suc m \<^esup>\<cdot> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup> =  x\<^bsub>0\<^esub>\<^bsup>m\<^esup> \<cdot> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup> + x\<^bsup>Suc m \<^esup>\<cdot> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup>"
      by (simp add: powsum2)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (m + n)\<^esup> + x\<^bsup>Suc m \<^esup>\<cdot> x\<^bsub>0\<^esub>\<^bsup>Suc n\<^esup>"
      by (simp add:hyp)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (m + n)\<^esup> + x\<^bsub>Suc m\<^esub>\<^bsup>Suc n\<^esup>"
      by (subst powsum_shift, simp)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (m + n)\<^esup> + (x\<^bsub>Suc m\<^esub>\<^bsup>n\<^esup> + x\<^bsup>Suc m + Suc n\<^esup>)"
      by (simp add:powsum2)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (m + n)\<^esup> + x\<^bsub>Suc m\<^esub>\<^bsup>n\<^esup> + x\<^bsup>Suc (Suc (m + n))\<^esup>"
      by (metis add_Suc_right add_Suc_shift add.assoc add.left_commute)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (m + n)\<^esup> + x\<^bsup>Suc (Suc (m + n))\<^esup>"
      by (simp only: add_Suc_right[THEN sym] add_Suc_shift[THEN sym] powsum_split_var4)
    also have "... = x\<^bsub>0\<^esub>\<^bsup>Suc (Suc m + n)\<^esup>"
      by (simp add: powsum2)
    finally show ?thesis .
  qed
qed

lemma powsum_prod: "x\<^bsub>0\<^esub>\<^bsup>m \<^esup>\<cdot> x\<^bsub>0\<^esub>\<^bsup>n\<^esup> = x\<^bsub>0\<^esub>\<^bsup>m+n\<^esup>"
  by (cases n, simp, simp add: powsum_prod_suc)

end

end


section\<open>Left Complemented Monoid\<close>

theory LeftComplementedMonoid
  imports Operations LatticeProperties.Lattice_Prop
begin

class right_pordered_monoid_mult = order + monoid_mult +
  assumes mult_right_mono: "a \<le> b \<Longrightarrow> a * c \<le> b * c"

class one_greatest = one + ord +
  assumes one_greatest [simp]: "a \<le> 1"

class integral_right_pordered_monoid_mult = right_pordered_monoid_mult + one_greatest

class left_residuated = ord + times + left_imp +
  assumes left_residual: "(x * a \<le> b) = (x \<le> a l\<rightarrow> b)"

class left_residuated_pordered_monoid = integral_right_pordered_monoid_mult + left_residuated

class left_inf = inf + times + left_imp +
  assumes inf_l_def: "(a \<sqinter> b)  = (a l\<rightarrow> b) * a"

class left_complemented_monoid = left_residuated_pordered_monoid + left_inf +
  assumes right_divisibility: "(a \<le> b) = (\<exists> c . a = c * b)"
begin
lemma lcm_D: "a l\<rightarrow> a = 1"
  apply (rule antisym, simp)
  by (unfold left_residual [THEN sym], simp)

subclass semilattice_inf
    apply unfold_locales
    apply (metis inf_l_def right_divisibility)
    apply (metis inf_l_def left_residual order_refl)
    by (metis inf_l_def left_residual mult_right_mono right_divisibility)

  lemma left_one_inf [simp]: "1 \<sqinter> a = a"
    by (rule antisym, simp_all)

  lemma left_one_impl [simp]: "1 l\<rightarrow> a = a"
    (*by (metis inf_l_def left_one_inf mult.right_neutral)*)
    proof -
      have "1 l\<rightarrow> a = 1 \<sqinter> a" by (unfold inf_l_def, simp)
      also have "1 \<sqinter> a = a" by simp
      finally show ?thesis .
    qed

  lemma lcm_A: "(a l\<rightarrow> b) * a = (b l\<rightarrow> a) * b"
    apply (unfold inf_l_def [THEN sym])
    by (simp add: inf_commute)

  lemma lcm_B: "((a * b) l\<rightarrow> c) = (a l\<rightarrow> (b l\<rightarrow> c))"
    apply (rule antisym)
    apply (simp add: left_residual [THEN sym] mult.assoc)
    apply (simp add: left_residual)

    apply (simp add: left_residual [THEN sym])
    apply (rule_tac y="(b l\<rightarrow> c) * b" in order_trans)
    apply (simp add: mult.assoc [THEN sym])
    apply (rule mult_right_mono)
    by (simp_all add: left_residual)

  lemma lcm_C: "(a \<le> b) = ((a l\<rightarrow> b) = 1)"
    (*by (metis eq_iff left_residual mult.left_neutral one_greatest)*)
    proof -
      have "(a \<le> b) = (1 * a \<le> b)" by simp
      also have "\<dots> = (1 \<le> a l\<rightarrow> b)" by (unfold left_residual, simp)
      also have "\<dots> = (a l\<rightarrow> b = 1)" apply safe by(rule antisym, simp_all)
      finally show ?thesis .
    qed

  end

class less_def = ord +
  assumes less_def: "(a < b) = ((a \<le> b) \<and> \<not> (b \<le> a))"

class one_times = one + times +
  assumes one_left [simp]: "1 * a = a"
  and one_right [simp]: "a * 1 = a"

class left_complemented_monoid_algebra = left_imp + one_times + left_inf + less_def +
  assumes left_impl_one [simp]: "a l\<rightarrow> a = 1"
  and left_impl_times: "(a l\<rightarrow> b) * a = (b l\<rightarrow> a) * b"
  and left_impl_ded: "((a * b) l\<rightarrow> c) = (a l\<rightarrow> (b l\<rightarrow> c))"
  and left_lesseq: "(a \<le> b) = ((a l\<rightarrow> b) = 1)"
begin
  lemma A: "(1 l\<rightarrow> a) l\<rightarrow> 1 = 1"
    proof -
      have "(1 l\<rightarrow> a) l\<rightarrow> 1 = (1 l\<rightarrow> a) * 1 l\<rightarrow> 1" by simp
      also have "... = (a l\<rightarrow> 1) * a l\<rightarrow> 1" by (subst left_impl_times, simp)
      also have "... = 1" by (simp add: left_impl_ded)
      finally show ?thesis .
    qed

  subclass order
    proof
      fix x y show "(x < y) = (x \<le> y \<and> \<not> y \<le> x)" by (unfold less_def, simp)
    next
      fix x show "x \<le> x" by (unfold left_lesseq, simp)
    next
      fix x y z assume a: "x \<le> y" assume b: "y \<le> z"
      have "x l\<rightarrow> z = 1 * x l\<rightarrow> z" by simp
      also have "... = (x l\<rightarrow> y) * x l\<rightarrow> z" by (cut_tac a, simp add: left_lesseq)
      also have "... = (y l\<rightarrow> x) * y l\<rightarrow> z" by (simp add: left_impl_times)
      also have "... = (y l\<rightarrow> x) l\<rightarrow> (y l\<rightarrow> z)" by (simp add: left_impl_ded)
      also have "... = (y l\<rightarrow> x) l\<rightarrow> 1" by (cut_tac b, simp add: left_lesseq)
      also have "... = (1 * y l\<rightarrow> x) l\<rightarrow> 1" by simp
      also have "... = (1 l\<rightarrow> (y l\<rightarrow> x)) l\<rightarrow> 1" by (subst left_impl_ded, simp)
      also have "... = 1" by (simp add: A)
      finally show "x \<le> z"  by (simp add: left_lesseq)
    next
      fix x y z assume a: "x \<le> y" assume b: "y \<le> x"
      have "x = (x l\<rightarrow> y) * x" by (cut_tac a, simp add: left_lesseq)
      also have "... = (y l\<rightarrow> x) * y" by (simp add: left_impl_times)
      also have "... = y" by (cut_tac b, simp add: left_lesseq)
      finally show "x = y" .
    qed

  lemma B: "(1 l\<rightarrow> a) \<le> 1"
    apply (unfold left_lesseq)
    by (rule A)

  lemma C: "a \<le> (1 l\<rightarrow> a)"
    by (simp add: left_lesseq left_impl_ded [THEN sym])

  lemma D: "a \<le> 1"
    apply (rule_tac y = "1 l\<rightarrow> a" in order_trans)
    by (simp_all add: C B)

  lemma less_eq: "(a \<le> b) = (\<exists> c . a = (c * b))"
    (*by (metis left_impl_ded left_impl_one left_impl_times left_lesseq one_left)*)
    apply safe
    apply (unfold left_lesseq)
    apply (rule_tac x = "b l\<rightarrow> a" in exI)
    apply (simp add: left_impl_times)
    apply (simp add: left_impl_ded)
    apply (case_tac "c \<le> 1")
    apply (simp add: left_lesseq)
    by (simp add: D)

  lemma F: "(a * b) * c l\<rightarrow> z = a * (b * c) l\<rightarrow> z"
    by (simp add: left_impl_ded)

  lemma associativity: "(a * b) * c = a * (b * c)"
    (*by (metis F left_impl_one left_impl_times one_left)*)
    apply (rule antisym)
    apply (unfold left_lesseq)
    apply (simp add: F)
    by (simp add: F [THEN sym])

  lemma H: "a * b \<le> b"
    apply (simp add: less_eq)
    by auto

  lemma I: "a * b l\<rightarrow> b = 1"
    apply (case_tac "a * b \<le> b")
    apply (simp add: left_lesseq)
    by (simp add: H)

  lemma L: "(x * a \<le> b) = (x \<le> a l\<rightarrow> b)"
    by (simp add: left_lesseq left_impl_ded)

  subclass left_complemented_monoid
    apply unfold_locales
    apply (simp_all add:  less_def D associativity K)
    apply (simp add: L)
    by (simp add: less_eq)
  end

lemma (in left_complemented_monoid) left_complemented_monoid:
    "class.left_complemented_monoid_algebra (*) inf (l\<rightarrow>) (\<le>) (<) 1"
  by (unfold_locales, simp_all add: less_le_not_le lcm_A lcm_B lcm_C lcm_D)

end