chapter SeCaV_Examples

(*
  Author: Jørgen Villadsen, DTU Compute, 2020
  Contributors: Asta Halkjær From & Alexander Birch Jensen
*)

section \<open>Sequent Calculus Verifier (SeCaV)\<close>

theory SeCaV_Examples imports SeCaV begin

section \<open>Examples\<close>

subsection \<open>Example 1\<close>

proposition \<open>p a \<longrightarrow> p a\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Pre 0 [Fun 0 []]) (Pre 0 [Fun 0 []])
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 0 []]),
      Pre 0 [Fun 0 []]
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 2\<close>

proposition \<open>p \<longrightarrow> \<not> \<not> p\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Pre 0 []) (Neg (Neg (Pre 0 [])))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 []),
      Neg (Neg (Pre 0 []))
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 3\<close>

proposition \<open>(\<forall>x. p x) \<longrightarrow> p a \<and> p b\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp (Uni (Pre 0 [Var 0])) (Con (Pre 0 [Fun 0 []]) (Pre 0 [Fun 1 []]))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Pre 0 [Var 0])),
      Con (Pre 0 [Fun 0 []]) (Pre 0 [Fun 1 []])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Con (Pre 0 [Fun 0 []]) (Pre 0 [Fun 1 []]),
      Neg (Uni (Pre 0 [Var 0]))
    ]
    \<close>
    using that by simp
  with BetaCon have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Neg (Uni (Pre 0 [Var 0]))
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 0 [Fun 1 []],
      Neg (Uni (Pre 0 [Var 0]))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Pre 0 [Var 0])),
      Pre 0 [Fun 0 []]
    ]
    \<close> and \<open>\<tturnstile>
    [
      Neg (Uni (Pre 0 [Var 0])),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with GammaUni have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 0 []]),
      Pre 0 [Fun 0 []]
    ]
    \<close> and \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 1 []]),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 0 [Fun 1 []],
      Neg (Pre 0 [Fun 1 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 4\<close>

proposition \<open>(\<forall>x. p x \<longrightarrow> q x) \<longrightarrow> (\<exists>x. p x) \<longrightarrow> (\<exists>x. q x)\<close> by metis

lemma \<open>\<tturnstile>
  [
    Imp
      (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
      (Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0])))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0]))),
      Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0]))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0])),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Exi (Pre 0 [Var 0])),
      Exi (Pre 1 [Var 0]),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with DeltaExi have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0]),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0]))),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with GammaUni have ?thesis if \<open>\<tturnstile>
    [
      Neg (Imp (Pre 0 [Fun 0 []]) (Pre 1 [Fun 0 []])),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Exi (Pre 1 [Var 0]),
      Neg (Imp (Pre 0 [Fun 0 []]) (Pre 1 [Fun 0 []])),
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with GammaExi have ?thesis if \<open>\<tturnstile>
    [
      Pre 1 [Fun 0 []],
      Neg (Imp (Pre 0 [Fun 0 []]) (Pre 1 [Fun 0 []])),
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Neg (Imp (Pre 0 [Fun 0 []]) (Pre 1 [Fun 0 []])),
      Pre 1 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with BetaImp have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Pre 1 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Neg (Pre 1 [Fun 0 []]),
      Pre 1 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Pre 1 [Fun 0 []],
      Neg (Pre 1 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

subsection \<open>Example 5\<close>

proposition \<open>\<exists>x. \<forall>y. p y \<or> \<not> p x\<close> by metis

lemma \<open>\<tturnstile>
  [
    Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1]))))
  ]
  \<close>
proof -
  from Ext have ?thesis if \<open>\<tturnstile>
    [
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1])))),
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1]))))
    ]
    \<close>
    using that by simp
  with GammaExi[where t=\<open>Fun 0 []\<close>] have ?thesis if \<open>\<tturnstile>
    [
      Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Fun 0 []]))),
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1]))))
    ]
    \<close>
    using that by simp
  with DeltaUni have ?thesis if \<open>\<tturnstile>
    [
      Dis (Pre 0 [Fun 1 []]) (Neg (Pre 0 [Fun 0 []])),
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1]))))
    ]
    \<close>
    using that by simp
  with AlphaDis have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 1 []],
      Neg (Pre 0 [Fun 0 []]),
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1]))))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Exi (Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Var 1])))),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with GammaExi[where t=\<open>Fun 1 []\<close>] have ?thesis if \<open>\<tturnstile>
    [
      Uni (Dis (Pre 0 [Var 0]) (Neg (Pre 0 [Fun 1 []]))),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with DeltaUni have ?thesis if \<open>\<tturnstile>
    [
      Dis (Pre 0 [Fun 3 []]) (Neg (Pre 0 [Fun 1 []])),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with AlphaDis have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 3 []],
      Neg (Pre 0 [Fun 1 []]),
      Pre 0 [Fun 1 []]
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 1 []],
      Neg (Pre 0 [Fun 1 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

end


section\<open>Modular and Distributive Lattices\<close>

(*
    Author: Viorel Preoteasa
*)

theory Modular_Distrib_Lattice
imports Lattice_Prop
begin

text \<open>
The main result of this theory is the fact that a lattice is distributive
if and only if it satisfies the following property:
\<close>

term "(\<forall> x y z . x \<sqinter> z = y \<sqinter> z \<and> x \<squnion> z = y \<squnion> z \<Longrightarrow> x = y)"

text\<open>
This result was proved by Bergmann in \<^cite>\<open>"bergmann:1929"\<close>. The formalization
presented here is based on \<^cite>\<open>"birkhoff:1967" and "burris:sankappanavar:1981"\<close>.
\<close>

class modular_lattice = lattice +
  assumes modular: "x \<le> y \<Longrightarrow>  x \<squnion> (y \<sqinter> z) = y \<sqinter> (x \<squnion> z)"

context distrib_lattice begin
subclass modular_lattice
  apply unfold_locales
  by (simp add: inf_sup_distrib inf_absorb2)
end

context lattice begin
definition
  "d_aux a b c = (a \<sqinter> b) \<squnion> (b \<sqinter> c) \<squnion> (c \<sqinter> a)"

lemma d_b_c_a: "d_aux b c a = d_aux a b c"
  by (metis d_aux_def sup.assoc sup_commute)

lemma d_c_a_b: "d_aux c a b = d_aux a b c"
  by (metis d_aux_def sup.assoc sup_commute)

definition
  "e_aux a b c = (a \<squnion> b) \<sqinter> (b \<squnion> c) \<sqinter> (c \<squnion> a)"

lemma e_b_c_a: "e_aux b c a = e_aux a b c"
  by (simp add: e_aux_def ac_simps)

lemma e_c_a_b: "e_aux c a b = e_aux a b c"
  by (simp add: e_aux_def ac_simps)

definition
  "a_aux a b c = (a \<sqinter> (e_aux a b c)) \<squnion> (d_aux a b c)"

definition
  "b_aux a b c = (b \<sqinter> (e_aux a b c)) \<squnion> (d_aux a b c)"

definition
  "c_aux a b c = (c \<sqinter> (e_aux a b c)) \<squnion> (d_aux a b c)"

lemma b_a: "b_aux a b c = a_aux b c a"
  by (simp add: a_aux_def b_aux_def e_b_c_a d_b_c_a)

lemma c_a: "c_aux a b c = a_aux c a b"
  by (simp add: a_aux_def c_aux_def e_c_a_b d_c_a_b)

lemma [simp]: "b_aux a b c \<le> e_aux a b c"
  apply (unfold b_a)
  apply (subst e_b_c_a [THEN sym])
  by simp

lemma [simp]: "c_aux a b c \<le> e_aux a b c"
  apply (unfold c_a)
  apply (subst e_c_a_b [THEN sym])
  by simp

lemma [simp]: "d_aux a b c \<le> a_aux a b c"
  by (simp add: a_aux_def e_aux_def d_aux_def)

lemma [simp]: "d_aux a b c \<le> b_aux a b c"
  apply (unfold b_a)
  apply (subst d_b_c_a [THEN sym])
  by simp

lemma [simp]: "d_aux a b c \<le> c_aux a b c"
  apply (unfold c_a)
  apply (subst d_c_a_b [THEN sym])
  by simp

lemma a_meet_e: "a \<sqinter> (e_aux a b c) = a \<sqinter> (b \<squnion> c)"
  by (rule order.antisym) (simp_all add: e_aux_def le_infI2)

lemma b_meet_e: "b \<sqinter> (e_aux a b c) = b \<sqinter> (c \<squnion> a)"
  by (simp add: a_meet_e [THEN sym] e_b_c_a)

lemma c_meet_e: "c \<sqinter> (e_aux a b c) = c \<sqinter> (a \<squnion> b)"
  by (simp add: a_meet_e [THEN sym] e_c_a_b)

lemma a_join_d: "a \<squnion> d_aux a b c = a \<squnion> (b \<sqinter> c)"
  by (rule order.antisym) (simp_all add: d_aux_def le_supI2)

lemma b_join_d: "b \<squnion> d_aux a b c = b \<squnion> (c \<sqinter> a)"
  by (simp add: a_join_d [THEN sym] d_b_c_a)

end

context lattice begin
definition
  "no_distrib a b c = (a \<sqinter> b \<squnion> c \<sqinter> a < a \<sqinter> (b \<squnion> c))"

definition
  "incomp x y = (\<not> x \<le> y \<and> \<not> y \<le> x)"

definition
  "N5_lattice a b c = (a \<sqinter> c = b \<sqinter> c \<and> a < b \<and> a \<squnion> c = b \<squnion> c)"

definition
  "M5_lattice a b c = (a \<sqinter> b = b \<sqinter> c \<and> c \<sqinter> a = b \<sqinter> c \<and> a \<squnion> b = b \<squnion> c \<and> c \<squnion> a = b \<squnion> c \<and> a \<sqinter> b < a \<squnion> b)"

lemma M5_lattice_incomp: "M5_lattice a b c \<Longrightarrow> incomp a b"
  apply (simp add: M5_lattice_def incomp_def)
  apply safe
  apply (simp_all add: inf_absorb1 inf_absorb2 )
  apply (simp_all add: sup_absorb1 sup_absorb2 )
  apply (subgoal_tac "c \<sqinter> (b \<squnion> c) = c")
  apply simp
  apply (subst sup_commute)
  by simp
end

context modular_lattice begin

lemma a_meet_d: "a \<sqinter> (d_aux a b c) = (a \<sqinter> b) \<squnion> (c \<sqinter> a)"
  proof -
    have "a \<sqinter> (d_aux a b c) = a \<sqinter> ((a \<sqinter> b) \<squnion> (b \<sqinter> c) \<squnion> (c \<sqinter> a))" by (simp add: d_aux_def)
    also have "... = a \<sqinter> (a \<sqinter> b \<squnion> c \<sqinter> a \<squnion> b \<sqinter> c)" by (simp add: sup_assoc, simp add: sup_commute)
    also have "... = (a \<sqinter> b \<squnion> c \<sqinter> a) \<squnion> (a \<sqinter> (b \<sqinter> c))" by (simp add: modular)
    also have "... = (a \<sqinter> b) \<squnion> (c \<sqinter> a)" by (rule order.antisym, simp_all, rule_tac y = "a \<sqinter> b" in order_trans, simp_all)
    finally show ?thesis by simp
  qed

lemma b_meet_d: "b \<sqinter> (d_aux a b c) = (b \<sqinter> c) \<squnion> (a \<sqinter> b)"
  by (simp add: a_meet_d [THEN sym] d_b_c_a)

lemma c_meet_d: "c \<sqinter> (d_aux a b c) = (c \<sqinter> a) \<squnion> (b \<sqinter> c)"
  by (simp add: a_meet_d [THEN sym] d_c_a_b)

lemma d_less_e: "no_distrib a b c \<Longrightarrow> d_aux a b c < e_aux a b c"
  apply (subst less_le)
  apply(case_tac "d_aux a b c = e_aux a b c")
  apply simp_all
  apply (simp add: no_distrib_def a_meet_e [THEN sym] a_meet_d [THEN sym])
  apply (rule_tac y = "a_aux a b c" in order_trans)
  by simp_all

lemma a_meet_b_eq_d: " d_aux a b c \<le> e_aux a b c \<Longrightarrow> a_aux a b c \<sqinter> b_aux a b c = d_aux a b c"
  proof -
    assume d_less_e: " d_aux a b c \<le> e_aux a b c"
    have "(a \<sqinter> e_aux a b c \<squnion> d_aux a b c) \<sqinter> (b \<sqinter> e_aux a b c \<squnion> d_aux a b c) = (b \<sqinter> e_aux a b c \<squnion>  d_aux a b c) \<sqinter> (d_aux a b c \<squnion> a \<sqinter> e_aux a b c)"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = d_aux a b c \<squnion> ((b \<sqinter> e_aux a b c \<squnion> d_aux a b c) \<sqinter> (a \<sqinter> e_aux a b c))"
      by (simp add: modular)
    also have "\<dots> = d_aux a b c \<squnion> (d_aux a b c \<squnion> e_aux a b c \<sqinter> b) \<sqinter> (a \<sqinter> e_aux a b c)"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = d_aux a b c \<squnion> (e_aux a b c \<sqinter> (d_aux a b c \<squnion> b)) \<sqinter> (a \<sqinter> e_aux a b c)"
      by (cut_tac d_less_e, simp add: modular [THEN sym] less_le)
    also have "\<dots> =  d_aux a b c \<squnion> ((a \<sqinter> e_aux a b c) \<sqinter> (e_aux a b c \<sqinter> (b \<squnion> d_aux a b c)))"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> e_aux a b c \<sqinter> (b \<squnion> d_aux a b c))" by (simp add: inf_assoc)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> e_aux a b c \<sqinter> (b \<squnion> (c \<sqinter> a)))" by (simp add: b_join_d)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> (b \<squnion> c) \<sqinter> (b \<squnion> (c \<sqinter> a)))" by (simp add: a_meet_e)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> ((b \<squnion> c) \<sqinter> (b \<squnion> (c \<sqinter> a))))" by (simp add: inf_assoc)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> (b \<squnion> ((b \<squnion> c) \<sqinter> (c \<sqinter> a))))" by (simp add: modular)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> (b \<squnion> (c \<sqinter> a)))" by (simp add: inf_absorb2)
    also have "\<dots> = d_aux a b c \<squnion> (a \<sqinter> ((c \<sqinter> a) \<squnion> b))" by (simp add: sup_commute inf_commute)
    also have "\<dots> = d_aux a b c \<squnion> ((c \<sqinter> a) \<squnion> (a \<sqinter> b))" by (simp add: modular)
    also have "\<dots> = d_aux a b c"
      by (rule order.antisym, simp_all add: d_aux_def)
    finally show ?thesis by (simp add: a_aux_def b_aux_def)
  qed

lemma b_meet_c_eq_d: " d_aux a b c \<le> e_aux a b c \<Longrightarrow> b_aux a b c \<sqinter> c_aux a b c = d_aux a b c"
  apply (subst b_a)
  apply (subgoal_tac "c_aux a b c = b_aux b c a")
  apply simp
  apply (subst a_meet_b_eq_d)
  by (simp_all add: c_aux_def b_aux_def d_b_c_a e_b_c_a)

lemma c_meet_a_eq_d: "d_aux a b c \<le> e_aux a b c \<Longrightarrow> c_aux a b c \<sqinter> a_aux a b c = d_aux a b c"
  apply (subst c_a)
  apply (subgoal_tac "a_aux a b c = b_aux c a b")
  apply simp
  apply (subst a_meet_b_eq_d)
  by (simp_all add: a_aux_def b_aux_def d_b_c_a e_b_c_a)

lemma a_def_equiv: "d_aux a b c \<le> e_aux a b c \<Longrightarrow> a_aux a b c = (a \<squnion> d_aux a b c) \<sqinter> e_aux a b c"
  apply (simp add: a_aux_def)
  apply (subst inf_commute)
  apply (subst sup_commute)
  apply (simp add: modular)
  by (simp add: inf_commute sup_commute)

lemma b_def_equiv: "d_aux a b c \<le> e_aux a b c \<Longrightarrow> b_aux a b c = (b \<squnion> d_aux a b c) \<sqinter> e_aux a b c"
  apply (cut_tac a = b and b = c and c = a in a_def_equiv)
  by (simp_all add: d_b_c_a e_b_c_a b_a)

lemma c_def_equiv: "d_aux a b c \<le> e_aux a b c \<Longrightarrow> c_aux a b c = (c \<squnion> d_aux a b c) \<sqinter> e_aux a b c"
  apply (cut_tac a = c and b = a and c = b in a_def_equiv)
  by (simp_all add: d_c_a_b e_c_a_b c_a)

lemma a_join_b_eq_e: "d_aux a b c \<le> e_aux a b c \<Longrightarrow> a_aux a b c \<squnion> b_aux a b c = e_aux a b c"
  proof -
    assume d_less_e: " d_aux a b c \<le> e_aux a b c"
    have "((a \<squnion> d_aux a b c) \<sqinter> e_aux a b c) \<squnion> ((b \<squnion> d_aux a b c) \<sqinter> e_aux a b c) = ((b \<squnion> d_aux a b c) \<sqinter> e_aux a b c) \<squnion> (e_aux a b c \<sqinter> (a \<squnion> d_aux a b c))"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = e_aux a b c \<sqinter> (((b \<squnion> d_aux a b c) \<sqinter> e_aux a b c) \<squnion> (a \<squnion> d_aux a b c))"
      by (simp add: modular)
    also have "\<dots> = e_aux a b c \<sqinter> ((e_aux a b c \<sqinter> (d_aux a b c \<squnion> b)) \<squnion> (a \<squnion> d_aux a b c))"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = e_aux a b c \<sqinter> ((d_aux a b c \<squnion> (e_aux a b c \<sqinter> b)) \<squnion> (a \<squnion> d_aux a b c))"
      by (cut_tac d_less_e, simp add: modular)
    also have "\<dots> = e_aux a b c \<sqinter> ((a \<squnion> d_aux a b c) \<squnion> (d_aux a b c \<squnion> (b \<sqinter> e_aux a b c)))"
      by (simp add: inf_commute sup_commute)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> d_aux a b c \<squnion> (b \<sqinter> e_aux a b c))" by (simp add: sup_assoc)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> d_aux a b c \<squnion> (b \<sqinter> (c \<squnion> a)))" by (simp add: b_meet_e)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> (b \<sqinter> c) \<squnion> (b \<sqinter> (c \<squnion> a)))" by (simp add: a_join_d)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> ((b \<sqinter> c) \<squnion> (b \<sqinter> (c \<squnion> a))))" by (simp add: sup_assoc)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> (b \<sqinter> ((b \<sqinter> c) \<squnion> (c \<squnion> a))))" by (simp add: modular)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> (b \<sqinter> (c \<squnion> a)))" by (simp add: sup_absorb2)
    also have "\<dots> = e_aux a b c \<sqinter> (a \<squnion> ((c \<squnion> a) \<sqinter> b))" by (simp add: sup_commute inf_commute)
    also have "\<dots> = e_aux a b c \<sqinter> ((c \<squnion> a) \<sqinter> (a \<squnion> b))" by (simp add: modular)
    also have "\<dots> = e_aux a b c"
      by (rule order.antisym, simp_all, simp_all add: e_aux_def)
    finally show ?thesis by (cut_tac d_less_e, simp add: a_def_equiv b_def_equiv)
  qed

lemma b_join_c_eq_e: " d_aux a b c <= e_aux a b c \<Longrightarrow> b_aux a b c \<squnion> c_aux a b c = e_aux a b c"
  apply (subst b_a)
  apply (subgoal_tac "c_aux a b c = b_aux b c a")
  apply simp
  apply (subst a_join_b_eq_e)
  by (simp_all add: c_aux_def b_aux_def d_b_c_a e_b_c_a)

lemma c_join_a_eq_e: "d_aux a b c <= e_aux a b c \<Longrightarrow> c_aux a b c \<squnion> a_aux a b c = e_aux a b c"
  apply (subst c_a)
  apply (subgoal_tac "a_aux a b c = b_aux c a b")
  apply simp
  apply (subst a_join_b_eq_e)
  by (simp_all add: a_aux_def b_aux_def d_b_c_a e_b_c_a)

lemma "no_distrib a b c \<Longrightarrow> incomp a b"
  apply (simp add: no_distrib_def incomp_def ac_simps)
  using order.strict_iff_not inf.absorb_iff2 inf.commute modular
  apply fastforce
  done

lemma M5_modular: "no_distrib a b c \<Longrightarrow> M5_lattice (a_aux a b c) (b_aux a b c) (c_aux a b c)"
  apply (frule d_less_e)
  by (simp add: M5_lattice_def a_meet_b_eq_d b_meet_c_eq_d c_meet_a_eq_d a_join_b_eq_e b_join_c_eq_e c_join_a_eq_e)

lemma M5_modular_def: "M5_lattice a b c = (a \<sqinter> b = b \<sqinter> c \<and> c \<sqinter> a = b \<sqinter> c \<and> a \<squnion> b = b \<squnion> c \<and> c \<squnion> a = b \<squnion> c \<and> a \<sqinter> b < a \<squnion> b)"
  by (simp add: M5_lattice_def)

end

context lattice begin

lemma not_modular_N5: "(\<not> class.modular_lattice inf ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) sup) =
   (\<exists> a b c::'a . N5_lattice a b c)"
  apply (subgoal_tac "class.lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) sup")
  apply (unfold N5_lattice_def class.modular_lattice_def class.modular_lattice_axioms_def)
  apply simp_all
  apply safe
  apply (subgoal_tac "x \<squnion> y \<sqinter> z < y \<sqinter> (x \<squnion> z)")
  apply (rule_tac x = "x \<squnion> y \<sqinter> z" in exI)
  apply (rule_tac x = "y \<sqinter> (x \<squnion> z)" in exI)
  apply (rule_tac x = z in exI)
  apply safe
  apply (rule order.antisym)
  apply simp
  apply (rule_tac y = "x \<squnion> y \<sqinter> z" in order_trans)
  apply simp_all
  apply (rule_tac y = "y \<sqinter> z" in order_trans)
  apply simp_all
  apply (rule order.antisym)
  apply simp_all
  apply (rule_tac y = "y \<sqinter> (x \<squnion> z)" in order_trans)
  apply simp_all
  apply (rule_tac y = "x \<squnion> z" in order_trans)
  apply simp_all
  apply (rule neq_le_trans)
  apply simp
  apply simp
  apply (rule_tac x = a in exI)
  apply (rule_tac x = b in exI)
  apply safe
  apply (simp add: less_le)
  apply (rule_tac x = c in exI)
  apply simp
  apply (simp add: less_le)
  apply safe
  apply (subgoal_tac "a \<squnion> a \<sqinter> c = b")
  apply (unfold sup_inf_absorb) [1]
  apply simp
  apply simp
  proof qed

lemma not_distrib_N5_M5: "(\<not> class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)) =
   ((\<exists> a b c::'a . N5_lattice a b c) \<or> (\<exists> a b c::'a . M5_lattice a b c))"
  apply (unfold not_modular_N5 [THEN sym])
  proof
    assume A: "\<not> class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)"
    have B: "\<exists> a b c:: 'a . (a \<sqinter> b) \<squnion> (a \<sqinter> c) < a \<sqinter> (b \<squnion> c)"
      apply (cut_tac A)
      apply (unfold  class.distrib_lattice_def)
      apply safe
      apply simp_all
      proof
        fix x y z::'a
        assume A: "\<forall>(a::'a) (b::'a) c::'a. \<not> a \<sqinter> b \<squnion> a \<sqinter> c < a \<sqinter> (b \<squnion> c)"
        show "x \<squnion> y \<sqinter> z = (x \<squnion> y) \<sqinter> (x \<squnion> z)"
          apply (cut_tac A)
          apply (rule distrib_imp1)
          by (simp add: less_le)
      qed
    from B show "\<not> class.modular_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>) \<or> (\<exists>a b c::'a. M5_lattice a b c)"
      proof (unfold disj_not1, safe)
        fix a b c::'a
        assume A: "a \<sqinter> b \<squnion> a \<sqinter> c < a \<sqinter> (b \<squnion> c)"
        assume B: "class.modular_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)"
        interpret modular: modular_lattice "(\<sqinter>)" "((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool)" "(<)" "(\<squnion>)"
          by (fact B)

        have H: "M5_lattice (a_aux a b c) (b_aux a b c) (c_aux a b c)"
          apply (cut_tac a = a and b = b and c = c in  modular.M5_modular)
          apply (unfold no_distrib_def)
          by (simp_all add: A inf_commute)
        from H show "\<exists>a b c::'a. M5_lattice a b c" by blast
     qed
   next
     assume A: "\<not> class.modular_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>) \<or> (\<exists>(a::'a) (b::'a) c::'a. M5_lattice a b c)"
     show "\<not> class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)"
       apply (cut_tac A)
       apply safe
       apply (erule notE)
       apply unfold_locales
       apply (unfold class.distrib_lattice_def)
       apply (unfold class.distrib_lattice_axioms_def)
       apply safe
       apply (simp add: sup_absorb2)
       apply (frule M5_lattice_incomp)
       apply (unfold M5_lattice_def)
       apply (drule_tac x = a in spec)
       apply (drule_tac x = b in spec)
       apply (drule_tac x = c in spec)
       apply safe
       proof -
         fix a b c:: 'a
         assume A:"a \<squnion> b \<sqinter> c = (a \<squnion> b) \<sqinter> (a \<squnion> c)"
         assume B: "a \<sqinter> b = b \<sqinter> c"
         assume D: "a \<squnion> b = b \<squnion> c"
         assume E: "c \<squnion> a = b \<squnion> c"
         assume G: "incomp a b"
         have H: "a \<squnion> b \<sqinter> c = a" by (simp add: B [THEN sym] sup_absorb1)
         have I: "(a \<squnion> b) \<sqinter> (a \<squnion> c) = a \<squnion> b" by (cut_tac E, simp add: sup_commute D)
         have J: "a = a \<squnion> b" by (cut_tac A, simp add: H I)
         show False
           apply (cut_tac G J)
           apply (subgoal_tac "b \<le> a")
           apply (simp add: incomp_def)
           apply (rule_tac y = "a \<squnion> b" in order_trans)
           apply (rule sup_ge2)
           by simp
       qed
     qed

lemma distrib_not_N5_M5: "(class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)) =
   ((\<forall> a b c::'a . \<not> N5_lattice a b c) \<and> (\<forall> a b c::'a . \<not> M5_lattice a b c))"
  apply (cut_tac not_distrib_N5_M5)
  by auto

lemma distrib_inf_sup_eq:
  "(class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)) =
    (\<forall> x y z::'a . x \<sqinter> z = y \<sqinter> z \<and> x \<squnion> z = y \<squnion> z \<longrightarrow> x = y)"
  apply safe
  proof -
    fix x y z:: 'a
    assume A: "class.distrib_lattice (\<sqinter>) ((\<le>) ::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)"
    interpret distrib: distrib_lattice "(\<sqinter>)" "(\<le>) :: 'a \<Rightarrow> 'a \<Rightarrow> bool" "(<)" "(\<squnion>)"
      by (fact A)
    assume B: "x \<sqinter> z = y \<sqinter> z"
    assume C: "x \<squnion> z = y \<squnion> z"
    have "x = x \<sqinter> (x \<squnion> z)" by simp
    also have "\<dots> = x \<sqinter> (y \<squnion> z)" by (simp add: C)
    also have "\<dots> = (x \<sqinter> y) \<squnion> (x \<sqinter> z)" by (simp add: distrib.inf_sup_distrib)
    also have "\<dots> = (y \<sqinter> x) \<squnion> (y \<sqinter> z)" by (simp add: B inf_commute)
    also have "\<dots> = y \<sqinter> (x \<squnion> z)" by (simp add: distrib.inf_sup_distrib)
    also have "\<dots> = y" by (simp add: C)
    finally show "x = y" .
  next
    assume A: "(\<forall>x y z:: 'a. x \<sqinter> z = y \<sqinter> z \<and> x \<squnion> z = y \<squnion> z \<longrightarrow> x = y)"
    have B: "!! x y z :: 'a. x \<sqinter> z = y \<sqinter> z \<and> x \<squnion> z = y \<squnion> z \<Longrightarrow> x = y"
      by (cut_tac A, blast)
    show "class.distrib_lattice (\<sqinter>) ((\<le>)::'a \<Rightarrow> 'a \<Rightarrow> bool) (<) (\<squnion>)"
      apply (unfold distrib_not_N5_M5)
      apply safe
      apply (unfold N5_lattice_def)
      apply (cut_tac x = a and y = b and z = c in B)
      apply (simp_all)
      apply (unfold M5_lattice_def)
      apply (cut_tac x = a and y = b and z = c in B)
      by (simp_all add: inf_commute sup_commute)
 qed
end

class inf_sup_eq_lattice = lattice +
  assumes inf_sup_eq: "x \<sqinter> z = y \<sqinter> z \<Longrightarrow> x \<squnion> z = y \<squnion> z \<Longrightarrow> x = y"
begin
subclass distrib_lattice
  by (metis distrib_inf_sup_eq inf_sup_eq)
end

end


(* IsageoCoq2_R1

Tarski_Non_Euclidean.thy

Version 2.1.0 IsaGeoCoq2_R1
Copyright (C) 2021-2023 Roland Coghetto roland.coghetto ( a t ) cafr-msa2p.be
License: LGPGL

History
Version 1.0.0: IsaGeoCoq
Port part of GeoCoq 3.4.0 (https://geocoq.github.io/GeoCoq/) in Isabelle/Hol (Isabelle2021)

Copyright (C) 2021  Roland Coghetto roland_coghetto (at) hotmail.com

License: LGPL

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
*)

section "In Tarski Non Euclidean"

(* TODO
NPost04 ?
NPost31 ?
NPost32 ?
NPost33 ?
NPost34 ?
*)
theory Tarski_Non_Euclidean

imports
  Tarski_Neutral
  Tarski_Postulate_Parallels

begin

subsection "Definitions"

locale Tarski_Non_Euclidean = Tarski_neutral_dimensionless +
  fixes A0 B0 C0 D0 T0
  assumes NERule1: "Bet A0 D0 T0" and
    NERule2: "Bet B0 D0 C0" and
    NERule3: "A0 \<noteq> D0" and
    not_tarski_s_parallel_postulate_aux:
    "\<forall> X Y. ((Bet A0 B0 X \<and> Bet A0 C0 Y) \<longrightarrow> \<not> Bet X T0 Y)"

lemma (in Tarski_Non_Euclidean) Tarski_Pre_Non_Euclidean_aux:
  shows "\<exists> A B C D T. \<not> ((Bet A D T \<and> Bet B D C \<and> A \<noteq> D)
                         \<longrightarrow>
                      (\<exists> X Y. Bet A B X \<and> Bet A C Y \<and> Bet X T Y))"
  using NERule1 NERule2 NERule3 not_tarski_s_parallel_postulate_aux by blast

locale Tarski_Greenberg_Non_Euclidean = Tarski_Non_Euclidean +
  assumes greenberg: "\<forall> P Q R A B C.
\<not> Col A B C \<and> Acute A B C \<and> Q \<noteq> R \<and> Per P Q R \<longrightarrow>
(\<exists> S. P S Q LtA A B C \<and> Q Out S R)"

subsection "Theorems - Postulates"

subsection "Tarski non euclidean (General)"

context Tarski_Non_Euclidean

begin

lemma NPost01:
  shows "\<not> Postulate01"
  using Postulate01_def Tarski_Pre_Non_Euclidean_aux
    tarski_s_parallel_postulate_def by blast

theorem not_tarski_s_parallel_postulate_thm:
  shows "\<exists> A B C D T. (Bet A D T \<and> Bet B D C \<and> A \<noteq> D \<and>
                      (\<forall> X Y. (Bet A B X \<and> Bet A C Y) \<longrightarrow> \<not> Bet X T Y))"
  using Tarski_Pre_Non_Euclidean_aux by blast

lemma NPost02:
  shows "\<not> Postulate02"
  using InterAx5 NPost01 by blast

theorem not_playfair_s_postulate_thm:
  shows "\<exists> A1 A2 B1 B2 C1 C2 P. A1 A2 Par B1 B2 \<and>
Col P B1 B2 \<and> A1 A2 Par C1 C2 \<and> Col P C1 C2 \<and>
    ( \<not> Col C1 B1 B2 \<or> \<not> Col C2 B1 B2)"
  using NPost02 Postulate02_def playfair_s_postulate_def by blast

lemma NPost05:
  shows "\<not> Postulate05"
  using NPost02 Postulate02_def Postulate05_def par_trans_implies_playfair by blast

theorem not_postulate_of_transitivity_of_parallelism_thm:
  shows "\<exists> A1 A2 B1 B2 C1 C2.
A1 A2 Par B1 B2 \<and> B1 B2 Par C1 C2 \<and> \<not> (A1 A2 Par C1 C2)"
  using NPost05 Postulate05_def
    postulate_of_transitivity_of_parallelism_def by blast

lemma NPost06:
  shows "\<not> Postulate06"
  by (simp add: NPost02 equivalent_postulates_without_decidability_of_intersection_of_lines)

theorem not_midpoint_converse_postulate_thm:
  shows "\<exists> A B C P Q.
  \<not> Col A B C \<and> P Midpoint B C \<and> A B Par Q P \<and> Col A C Q \<and> \<not> Q Midpoint A C"
  using NPost06 midpoint_converse_postulate_def
    Postulate06_def by blast

lemma NPost07:
  shows "\<not> Postulate07"
  using NPost02 equivalent_postulates_without_decidability_of_intersection_of_lines by blast

theorem not_alternate_interior_angles_postulate_thm:
  shows "\<exists> A B C D. A C TS B D \<and> A B Par C D \<and> \<not> B A C CongA D C A"
  using NPost07 Postulate07_def alternate_interior_angles_postulate_def by blast

lemma NPost08:
  shows "\<not> Postulate08"
  using NPost06 equivalent_postulates_without_decidability_of_intersection_of_lines by blast

theorem not_consecutive_interior_angles_postulate_thm:
  shows "\<exists> A B C D. B C OS A D \<and> A B Par C D \<and> \<not> A B C SuppA B C D"
  using NPost08 Postulate08_def consecutive_interior_angles_postulate_def by blast

lemma NPost09:
  shows "\<not> Postulate09"
  by (simp add: NPost02 equivalent_postulates_without_decidability_of_intersection_of_lines)

theorem not_perpendicular_transversal_postulate_thm:
  shows "\<exists> A B C D P Q. A B Par C D \<and> A B Perp P Q \<and>
Coplanar C D P Q \<and> \<not> C D Perp P Q"
  using NPost09 Postulate09_def perpendicular_transversal_postulate_def by blast

lemma NPost10:
  shows "\<not> Postulate10"
  using NPost05 equivalent_postulates_without_decidability_of_intersection_of_lines by blast

theorem not_postulate_of_parallelism_of_perpendicular_transversals_thm:
  shows "\<exists> A1 A2 B1 B2 C1 C2 D1 D2.
   A1 A2 Par B1 B2 \<and> A1 A2 Perp C1 C2 \<and> B1 B2 Perp D1 D2 \<and>
   Coplanar A1 A2 C1 D1 \<and> Coplanar A1 A2 C1 D2 \<and>
   Coplanar A1 A2 C2 D1 \<and> Coplanar A1 A2 C2 D2 \<and> \<not> C1 C2 Par D1 D2"
  using NPost10 Postulate10_def
    postulate_of_parallelism_of_perpendicular_transversals_def by blast

lemma NPost11:
  shows "\<not> Postulate11"
  using NPost02 equivalent_postulates_without_decidability_of_intersection_of_lines by fastforce

theorem not_universal_posidonius_postulate:
  shows "\<exists> A1 A2 A3 A4 B1 B2 B3 B4.
   A1 A2 Par B1 B2 \<and> Col A1 A2 A3 \<and> Col B1 B2 B3 \<and> A1 A2 Perp A3 B3 \<and>
   Col A1 A2 A4 \<and> Col B1 B2 B4 \<and> A1 A2 Perp A4 B4 \<and> \<not> Cong A3 B3 A4 B4"
  using NPost11 Postulate11_def universal_posidonius_postulate_def by blast

lemma NPost12:
  shows "\<not> Postulate12"
  using NPost02 Postulate02_def Postulate12_def playfair_bis__playfair by blast

theorem not_alternative_playfair_s_postulate_thm:
  shows "\<exists> A1 A2 B1 B2 C1 C2 P.
     P Perp2 A1 A2 B1 B2 \<and> \<not> Col A1 A2 P \<and> Col P B1 B2 \<and>
     Coplanar A1 A2 B1 B2 \<and> A1 A2 Par C1 C2 \<and> Col P C1 C2 \<and>
     (\<not> Col C1 B1 B2 \<or> \<not> Col C2 B1 B2)"
  using NPost02 Postulate02_def alternative_playfair_s_postulate_def
    playfair_bis__playfair by blast

lemma NPost13:
  shows "\<not> Postulate13"
  using Cycle_2 NPost01 by blast

theorem not_proclus_postulate_thm:
  shows "\<exists> A B C D P Q. (\<forall> Y. A B Par C D \<and> Col A B P \<and>
\<not> Col A B Q \<and> Coplanar C D P Q \<and> (\<not> Col P Q Y \<or> \<not> Col C D Y))"
  using NPost13 proclus_postulate_def Postulate13_def by blast

lemma NPost14:
  shows "\<not> Postulate14"
  using Cycle_2 NPost13 by blast

theorem not_alternative_proclus_postulate_thm:
  shows "\<exists> A B C D P Q. (\<forall> Y. P Perp2 A B C D \<and>
\<not> Col C D P \<and> Coplanar A B C D \<and> Col A B P \<and>
    \<not> Col A B Q \<and> Coplanar C D P Q \<and> (\<not> Col P Q Y \<or> \<not> Col C D Y))"
  using NPost14 alternative_proclus_postulate_def Postulate14_def by blast

lemma NPost15:
  shows "\<not> Postulate15"
  using Cycle_1 NPost02 by blast

theorem not_triangle_circumscription_principle_thm:
  shows "\<exists> A B C. \<forall> D. (\<not> Col A B C \<and>
(\<not> Cong A D B D \<or> \<not> Cong A D C D \<or> \<not> Coplanar A B C D))"
  using NPost15 Postulate15_def
    triangle_circumscription_principle_def by blast

lemma NPost16:
  shows "\<not> Postulate16"
  using Cycle_2 NPost01 by blast

theorem not_inverse_projection_postulate_thm:
  shows "\<exists> A B C P Q. \<forall> Y.
     Acute A B C \<and> B Out A P \<and> P \<noteq> Q \<and> Per B P Q \<and> Coplanar A B C Q \<and>
(\<not> B Out C Y \<or> \<not> Col P Q Y)"
  using NPost16 Postulate16_def inverse_projection_postulate_def by blast

lemma NPost17:
  shows "\<not> Postulate17"
  using Cycle_2 NPost01 by blast

theorem not_euclid_5_thm:
  shows "\<exists> P Q R S T U. \<forall> I.
     BetS P T Q \<and> BetS R T S \<and> BetS Q U R \<and> \<not> Col P Q S \<and>
Cong P T Q T \<and> Cong R T S T \<and> (\<not> BetS S Q I \<or> \<not> BetS P U I)"
  using NPost17 Postulate17_def euclid_5_def by blast

lemma NPost18:
  shows "\<not> Postulate18"
  using Cycle_2 NPost01 by blast

theorem not_strong_parallel_postulate_thm:
  shows "\<exists> P Q R S T U. \<forall> I.
    BetS P T Q \<and> BetS R T S \<and> \<not> Col P R U \<and> Coplanar P Q R U \<and>
    Cong P T Q T \<and> Cong R T S T \<and> (\<not> Col S Q I \<or> \<not> Col P U I)"
  using NPost18 Postulate18_def strong_parallel_postulate_def by blast

lemma NPost19:
  shows "\<not> Postulate19"
  using Cycle_2 NPost01 by blast

theorem not_alternative_strong_parallel_postulate_thm:
  shows "\<exists> A B C D P Q R. \<forall> Y.
   B C OS A D \<and> A B C B C D SumA P Q R \<and> \<not> Bet P Q R
\<and> (\<not> Col B A Y \<or> \<not> Col C D Y)"
  using NPost19 Postulate19_def alternative_strong_parallel_postulate_def by blast

lemma NPost20:
  shows "\<not> Postulate20"
  using Cycle_2 NPost01 by blast

theorem not_euclid_s_parallel_postulate_thm:
  shows "\<exists> A B C D P Q R. \<forall> Y.
     B C OS A D \<and> SAMS A B C B C D \<and> A B C B C D SumA P Q R \<and>
\<not> Bet P Q R \<and> (\<not> B Out A Y \<or> \<not> C Out D Y)"
  using NPost20 Postulate20_def euclid_s_parallel_postulate_def by blast

end

subsection "Tarski non euclidean (with Greenberg axiom)"

context Tarski_Greenberg_Non_Euclidean

begin

lemma Greenberg_s_axiom_thm:
  shows "greenberg_s_axiom"
  using greenberg_s_axiom_def greenberg greenberg_s_axiom_def by blast

lemma NPost03:
  shows "\<not> Postulate03"
  using Greenberg_s_axiom_thm InterCycle1 NPost02 Postulate02_def
    Postulate12_def playfair_bis__playfair by blast

theorem not_triangle_postulate_thm:
  shows "\<exists> A B C D E F. A B C TriSumA D E F \<and> \<not> Bet D E F"
  using NPost03 Postulate03_def triangle_postulate_def by blast

lemma NPost21:
  shows "\<not> Postulate21"
  using Cycle_3 Greenberg_s_axiom_thm NPost03 by blast

theorem not_postulate_of_existence_of_a_triangle_whose_angles_sum_to_two_rights_thm:
  shows "\<forall> A B C D E F. A B C TriSumA D E F \<and> Bet D E F \<longrightarrow> Col A B C"
  using NPost21 Postulate21_def
    postulate_of_existence_of_a_triangle_whose_angles_sum_to_two_rights_def by blast

lemma NPost22:
  shows "\<not> Postulate22"
  using Cycle_3 Greenberg_s_axiom_thm NPost21 by blast

theorem not_posidonius_postulate_thm:
  shows "\<forall> A1 A2 B1 B2.
 Col A1 A2 B1 \<or> B1 = B2 \<or> \<not> Coplanar A1 A2 B1 B2 \<or>
    (\<exists> A3 A4 B3 B4.
              Col A1 A2 A3 \<and> Col B1 B2 B3 \<and> A1 A2 Perp A3 B3 \<and>
              Col A1 A2 A4 \<and> Col B1 B2 B4 \<and> A1 A2 Perp A4 B4 \<and>
        \<not> Cong A3 B3 A4 B4) "
  using NPost22 Postulate22_def posidonius_postulate_def by blast

theorem not_posidonius_postulate_thm_1:
  shows "\<forall> A1 A2 B.
 Col A1 A2 B \<or> (\<exists> A3 A4 B3 B4.
              Col A1 A2 A3 \<and> Col B B B3 \<and> A1 A2 Perp A3 B3 \<and>
              Col A1 A2 A4 \<and> Col B B B4 \<and> A1 A2 Perp A4 B4 \<and>
        \<not> Cong A3 B3 A4 B4)"
proof -
  {
    fix A1 A2 B
    have "Coplanar A1 A2 B B"
      using ncop_distincts by blast
    assume "\<not> Col A1 A2 B"
    hence "    (\<exists> A3 A4 B3 B4.
              Col A1 A2 A3 \<and> Col B B B3 \<and> A1 A2 Perp A3 B3 \<and>
              Col A1 A2 A4 \<and> Col B B B4 \<and> A1 A2 Perp A4 B4 \<and>
        \<not> Cong A3 B3 A4 B4)"
      by (metis(full_types) col_trivial_1 ncop_distincts not_posidonius_postulate_thm)
  }
  thus ?thesis
    by blast
qed

lemma NPost23:
  shows "\<not> Postulate23"
  using Cycle_3 NPost21 Greenberg_s_axiom_thm by blast

theorem not_postulate_of_existence_of_similar_triangles_thm:
  shows "\<forall> A B C D E F.
  (Col A B C \<or> Cong A B D E \<or> \<not> A B C CongA D E F \<or>
   \<not> B C A CongA E F D \<or> \<not> C A B CongA F D E)"
  using NPost23 Postulate23_def postulate_of_existence_of_similar_triangles_def by blast

lemma NPost24:
  shows "\<not> Postulate24"
  using Cycle_3 NPost21 Greenberg_s_axiom_thm by blast

theorem not_thales_postulate_thm:
  shows "\<exists> A B C M.
   M Midpoint A B \<and> Cong M A M C \<and> \<not> Per A C B"
  using NPost24 Postulate24_def thales_postulate_def by blast

lemma NPost25:
  shows "\<not> Postulate25"
  using Cycle_3 NPost21 Greenberg_s_axiom_thm by blast

theorem not_thales_converse_postulate_thm:
  shows "\<exists> A B C M. M Midpoint A B \<and> Per A C B \<and> \<not> Cong M A M C"
  using NPost25 Postulate25_def thales_converse_postulate_def by blast

lemma NPost26:
  shows "\<not> Postulate26"
  using Cycle_3 NPost22 Greenberg_s_axiom_thm by blast

theorem not_existential_thales_postulate_thm:
  shows "\<forall> A B C M. (M Midpoint A B \<and> Cong M A M C \<and> Per A C B) \<longrightarrow> Col A B C"
  using NPost26 Postulate26_def existential_thales_postulate_def by blast

lemma NPost27:
  shows "\<not> Postulate27"
  using Cycle_3 NPost22 Greenberg_s_axiom_thm by fastforce

theorem not_postulate_of_right_saccheri_quadrilaterals_thm:
  shows "\<exists> A B C D. Saccheri A B C D \<and> \<not> Per A B C"
  using Cycle_3 NPost03 Postulate28_def ex_saccheri
    postulate_of_existence_of_a_right_saccheri_quadrilateral_def by blast

lemma NPost28:
  shows "\<not> Postulate28"
  using Cycle_3 NPost03 Greenberg_s_axiom_thm by blast

theorem not_postulate_of_existence_of_a_right_saccheri_quadrilateral_thm:
  shows "\<forall> A B C D. \<not> (Saccheri A B C D \<and> Per A B C)"
  using Cycle_3 NPost26 Postulate28_def
    postulate_of_existence_of_a_right_saccheri_quadrilateral_def by blast

lemma NPost29:
  shows "\<not> Postulate29"
  using Cycle_3 NPost27 Greenberg_s_axiom_thm by blast

theorem not_postulate_of_right_lambert_quadrilaterals_thm:
  shows "\<exists> A B C D. Lambert A B C D \<and> \<not> Per B C D"
  using Cycle_3 NPost26 Postulate30_def postulate_of_right_lambert_quadrilaterals_def
    rectangle_principle__rectangle_existence by blast

lemma NPost30:
  shows "\<not> Postulate30"
  using Cycle_3 NPost03 Greenberg_s_axiom_thm by blast

theorem not_postulate_of_existence_of_a_right_lambert_quadrilateral_thm:
  shows "\<forall> A B C D. \<not> (Lambert A B C D \<and> Per B C D)"
  using Cycle_3 NPost29 Postulate30_def
    postulate_of_existence_of_a_right_lambert_quadrilateral_def by blast

end
end


theory T155
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(x, meet(y, z)) = meet(mult(x, y), mult(x, 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. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


theory T177
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. undr(x, join(y, z)) = join(undr(x, y), undr(x, 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. 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. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=10,timeout=86400]
oops
end


theory T158
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. over(join(x, y), z) = join(over(x, z), over(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. undr(meet(x, y), z) = join(undr(x, z), undr(y, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


section \<open>Semantics\<close>

theory Semantics imports Syntax begin

subsection \<open>Definition\<close>

type_synonym 'a var_denot = \<open>nat \<Rightarrow> 'a\<close>
type_synonym 'a fun_denot = \<open>nat \<Rightarrow> 'a list \<Rightarrow> 'a\<close>
type_synonym 'a pre_denot = \<open>nat \<Rightarrow> 'a list \<Rightarrow> bool\<close>

primrec semantics_tm :: \<open>'a var_denot \<Rightarrow> 'a fun_denot \<Rightarrow> tm \<Rightarrow> 'a\<close> (\<open>\<lparr>_, _\<rparr>\<close>) where
  \<open>\<lparr>E, F\<rparr> (\<^bold>#n) = E n\<close>
| \<open>\<lparr>E, F\<rparr> (\<^bold>\<dagger>f ts) = F f (map \<lparr>E, F\<rparr> ts)\<close>

primrec semantics_fm :: \<open>'a var_denot \<Rightarrow> 'a fun_denot \<Rightarrow> 'a pre_denot \<Rightarrow> fm \<Rightarrow> bool\<close>
  (\<open>\<lbrakk>_, _, _\<rbrakk>\<close>) where
  \<open>\<lbrakk>_, _, _\<rbrakk> \<^bold>\<bottom> = False\<close>
| \<open>\<lbrakk>E, F, G\<rbrakk> (\<^bold>\<ddagger>P ts) = G P (map \<lparr>E, F\<rparr> ts)\<close>
| \<open>\<lbrakk>E, F, G\<rbrakk> (p \<^bold>\<longrightarrow> q) = (\<lbrakk>E, F, G\<rbrakk> p \<longrightarrow> \<lbrakk>E, F, G\<rbrakk> q)\<close>
| \<open>\<lbrakk>E, F, G\<rbrakk> (\<^bold>\<forall>p) = (\<forall>x. \<lbrakk>x \<Zsemi> E, F, G\<rbrakk> p)\<close>

fun sc :: \<open>('a var_denot \<times> 'a fun_denot \<times> 'a pre_denot) \<Rightarrow> sequent \<Rightarrow> bool\<close> where
  \<open>sc (E, F, G) (A, B) = ((\<forall>p [\<in>] A. \<lbrakk>E, F, G\<rbrakk> p) \<longrightarrow> (\<exists>q [\<in>] B. \<lbrakk>E, F, G\<rbrakk> q))\<close>

subsection \<open>Substitution\<close>

lemma add_env_semantics [simp]: \<open>\<lparr>E, F\<rparr> ((t \<Zsemi> s) n) = (\<lparr>E, F\<rparr> t \<Zsemi> \<lambda>m. \<lparr>E, F\<rparr> (s m)) n\<close>
  by (induct n) simp_all

lemma lift_

lemma sub_tm_semantics [simp]: \<open>\<lparr>E, F\<rparr> (sub_tm s t) = \<lparr>\<lambda>n. \<lparr>E, F\<rparr> (s n), F\<rparr> t\<close>
  by (induct t) (auto cong: map_cong)

lemma sub_fm_semantics [simp]: \<open>\<lbrakk>E, F, G\<rbrakk> (sub_fm s p) = \<lbrakk>\<lambda>n. \<lparr>E, F\<rparr> (s n), F, G\<rbrakk> p\<close>
  by (induct p arbitrary: E s) (auto cong: map_cong)

subsection \<open>Variables\<close>

lemma upd_vars_tm [simp]: \<open>n [\<notin>] vars_tm t \<Longrightarrow> \<lparr>E(n := x), F\<rparr> t = \<lparr>E, F\<rparr> t\<close>
  by (induct t) (auto cong: map_cong)

lemma add_upd_commute [simp]: \<open>(y \<Zsemi> E(n := x)) m = ((y \<Zsemi> E)(Suc n := x)) m\<close>
  by (induct m) simp_all

lemma upd_vars_fm [simp]: \<open>max_list (vars_fm p) < n \<Longrightarrow> \<lbrakk>E(n := x), F, G\<rbrakk> p = \<lbrakk>E, F, G\<rbrakk> p\<close>
proof (induct p arbitrary: E n)
  case (Pre P ts)
  moreover have \<open>max_list (concat (map vars_tm ts)) < n\<close>
    using Pre.prems max_list_concat by simp
  then have \<open>n [\<notin>] concat (map vars_tm ts)\<close>
    using max_list_in by blast
  then have \<open>\<forall>t [\<in>] ts. n [\<notin>] vars_tm t\<close>
    by simp
  ultimately show ?case
    using upd_vars_tm by (metis list.map_cong semantics_fm.simps(2))
next
  case (Uni p)
  have \<open>?case = ((\<forall>y. \<lbrakk>\<lambda>m. (y \<Zsemi> E(n := x)) m, F, G\<rbrakk> p) = (\<forall>y. \<lbrakk>y \<Zsemi> E, F, G\<rbrakk> p))\<close>
    by (simp add: fun_upd_def)
  then show ?case
    using Uni by simp
qed (auto simp: max_list_append cong: map_cong)

end


(*  Title:      HOL/TPTP/THF_Arith.thy
    Author:     Jasmin Blanchette
    Copyright   2011, 2012

Experimental setup for THF arithmetic. This is not connected with the TPTP
parser yet.
*)

theory THF_Arith
imports Complex_Main
begin

consts
  is_int :: "'a \<Rightarrow> bool"
  is_rat :: "'a \<Rightarrow> bool"

overloading rat_is_int \<equiv> "is_int :: rat \<Rightarrow> bool"
begin
  definition "rat_is_int (q\<Colon>rat) \<longleftrightarrow> (\<exists>n\<Colon>int. q = of_int n)"
end

overloading real_is_int \<equiv> "is_int :: real \<Rightarrow> bool"
begin
  definition "real_is_int (x\<Colon>real) \<longleftrightarrow> x \<in> \<int>"
end

overloading real_is_rat \<equiv> "is_rat :: real \<Rightarrow> bool"
begin
  definition "real_is_rat (x\<Colon>real) \<longleftrightarrow> x \<in> \<rat>"
end

consts
  to_int :: "'a \<Rightarrow> int"
  to_rat :: "'a \<Rightarrow> rat"
  to_real :: "'a \<Rightarrow> real"

overloading rat_to_int \<equiv> "to_int :: rat \<Rightarrow> int"
begin
  definition "rat_to_int (q\<Colon>rat) = floor q"
end

overloading real_to_int \<equiv> "to_int :: real \<Rightarrow> int"
begin
  definition "real_to_int (x\<Colon>real) = floor x"
end

overloading int_to_rat \<equiv> "to_rat :: int \<Rightarrow> rat"
begin
  definition "int_to_rat (n\<Colon>int) = (of_int n\<Colon>rat)"
end

overloading real_to_rat \<equiv> "to_rat :: real \<Rightarrow> rat"
begin
  definition "real_to_rat (x\<Colon>real) = (inv of_rat x\<Colon>rat)"
end

overloading int_to_real \<equiv> "to_real :: int \<Rightarrow> real"
begin
  definition "int_to_real (n\<Colon>int) = real n"
end

overloading rat_to_real \<equiv> "to_real :: rat \<Rightarrow> real"
begin
  definition "rat_to_real (x\<Colon>rat) = (of_rat x\<Colon>real)"
end

declare
  rat_is_int_def [simp]
  real_is_int_def [simp]
  real_is_rat_def [simp]
  rat_to_int_def [simp]
  real_to_int_def [simp]
  int_to_rat_def [simp]
  real_to_rat_def [simp]
  int_to_real_def [simp]
  rat_to_real_def [simp]

lemma to_rat_is_int [intro, simp]: "is_int (to_rat (n\<Colon>int))"
by (metis int_to_rat_def rat_is_int_def)

lemma to_real_is_int [intro, simp]: "is_int (to_real (n\<Colon>int))"
by (metis Ints_real_of_int int_to_real_def real_is_int_def)

lemma to_real_is_rat [intro, simp]: "is_rat (to_real (q\<Colon>rat))"
by (metis Rats_of_rat rat_to_real_def real_is_rat_def)

lemma inj_of_rat [intro, simp]: "inj (of_rat\<Colon>rat\<Rightarrow>real)"
by (metis injI of_rat_eq_iff)

end


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

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

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

fun sort2 :: "int => int => int list" where
  "sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun pairs :: "int list => int list => int list" where
  "pairs (nil2) z = z"
| "pairs (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "pairs (cons2 z2 x2) (cons2 x3 x4) =
     x (sort2 z2 x3) (pairs x2 x4)"

fun stitch :: "int list => int list => int list" where
  "stitch (nil2) z = z"
| "stitch (cons2 z2 xs) z = cons2 z2 (pairs xs z)"

function evens :: "'a list => 'a list"
  and odds :: "'a list => 'a list" where
  "evens (nil2) = nil2"
| "evens (cons2 z xs) = cons2 z (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 z xs) = evens xs"
  by pat_completeness auto

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

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

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

(*fun did not finish the proof*)
function bmerge :: "int list => int list => int list" where
  "bmerge (nil2) z = nil2"
| "bmerge (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "bmerge (cons2 z2 x2) (cons2 x3 x4) =
     (let fail :: int list =
       stitch
         (bmerge (evens (cons2 z2 x2)) (evens (cons2 x3 x4)))
         (bmerge (odds (cons2 z2 x2)) (odds (cons2 x3 x4)))
     in (case x2 of
           nil2 =>
             (case x4 of
                nil2 => sort2 z2 x3
                | cons2 x5 x6 => fail)
           | cons2 x7 x8 => fail))"
  by pat_completeness auto

(*fun did not finish the proof*)
function bsort :: "int list => int list" where
  "bsort (nil2) = nil2"
| "bsort (cons2 z (nil2)) = cons2 z (nil2)"
| "bsort (cons2 z (cons2 x2 x3)) =
     bmerge
       (bsort (evens (cons2 z (cons2 x2 x3))))
       (bsort (odds (cons2 z (cons2 x2 x3))))"
  by pat_completeness auto

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

end