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

Results from the book "Set Theory: an Introduction to Independence Proofs"
        by Kenneth Kunen.  Chapter 1, section 6.
Additional definitions and lemmas for reflexive orders.
*)

section{*Partial and Total Orderings: Basic Definitions and Properties*}

theory Order imports WF Perm begin

text {* We adopt the following convention: @{text ord} is used for
  strict orders and @{text order} is used for their reflexive
  counterparts. *}

definition
  part_ord :: "[i,i]=>o"                (*Strict partial ordering*)  where
   "part_ord(A,r) == irrefl(A,r) & trans[A](r)"

definition
  linear   :: "[i,i]=>o"                (*Strict total ordering*)  where
   "linear(A,r) == (\<forall>x\<in>A. \<forall>y\<in>A. <x,y>:r | x=y | <y,x>:r)"

definition
  tot_ord  :: "[i,i]=>o"                (*Strict total ordering*)  where
   "tot_ord(A,r) == part_ord(A,r) & linear(A,r)"

definition
  "preorder_on(A, r) \<equiv> refl(A, r) \<and> trans[A](r)"

definition                              (*Partial ordering*)
  "partial_order_on(A, r) \<equiv> preorder_on(A, r) \<and> antisym(r)"

abbreviation
  "Preorder(r) \<equiv> preorder_on(field(r), r)"

abbreviation
  "Partial_order(r) \<equiv> partial_order_on(field(r), r)"

definition
  well_ord :: "[i,i]=>o"                (*Well-ordering*)  where
   "well_ord(A,r) == tot_ord(A,r) & wf[A](r)"

definition
  mono_map :: "[i,i,i,i]=>i"            (*Order-preserving maps*)  where
   "mono_map(A,r,B,s) ==
              {f \<in> A->B. \<forall>x\<in>A. \<forall>y\<in>A. <x,y>:r \<longrightarrow> <f`x,f`y>:s}"

definition
  ord_iso  :: "[i,i,i,i]=>i"            (*Order isomorphisms*)  where
   "ord_iso(A,r,B,s) ==
              {f \<in> bij(A,B). \<forall>x\<in>A. \<forall>y\<in>A. <x,y>:r \<longleftrightarrow> <f`x,f`y>:s}"

definition
  pred     :: "[i,i,i]=>i"              (*Set of predecessors*)  where
   "pred(A,x,r) == {y \<in> A. <y,x>:r}"

definition
  ord_iso_map :: "[i,i,i,i]=>i"         (*Construction for linearity theorem*)  where
   "ord_iso_map(A,r,B,s) ==
     \<Union>x\<in>A. \<Union>y\<in>B. \<Union>f \<in> ord_iso(pred(A,x,r), r, pred(B,y,s), s). {<x,y>}"

definition
  first :: "[i, i, i] => o"  where
    "first(u, X, R) == u \<in> X & (\<forall>v\<in>X. v\<noteq>u \<longrightarrow> <u,v> \<in> R)"

notation (xsymbols)
  ord_iso  ("(\<langle>_, _\<rangle> \<cong>/ \<langle>_, _\<rangle>)" 51)

subsection{*Immediate Consequences of the Definitions*}

lemma part_ord_Imp_asym:
    "part_ord(A,r) ==> asym(r \<inter> A*A)"
by (unfold part_ord_def irrefl_def trans_on_def asym_def, blast)

lemma linearE:
    "[| linear(A,r);  x \<in> A;  y \<in> A;
        <x,y>:r ==> P;  x=y ==> P;  <y,x>:r ==> P |]
     ==> P"
by (simp add: linear_def, blast)

(** General properties of well_ord **)

lemma well_ordI:
    "[| wf[A](r); linear(A,r) |] ==> well_ord(A,r)"
apply (simp add: irrefl_def part_ord_def tot_ord_def
                 trans_on_def well_ord_def wf_on_not_refl)
apply (fast elim: linearE wf_on_asym wf_on_chain3)
done

lemma well_ord_is_wf:
    "well_ord(A,r) ==> wf[A](r)"
by (unfold well_ord_def, safe)

lemma well_ord_is_trans_on:
    "well_ord(A,r) ==> trans[A](r)"
by (unfold well_ord_def tot_ord_def part_ord_def, safe)

lemma well_ord_is_linear: "well_ord(A,r) ==> linear(A,r)"
by (unfold well_ord_def tot_ord_def, blast)

(** Derived rules for pred(A,x,r) **)

lemma pred_iff: "y \<in> pred(A,x,r) \<longleftrightarrow> <y,x>:r & y \<in> A"
by (unfold pred_def, blast)

lemmas predI = conjI [THEN pred_iff [THEN iffD2]]

lemma predE: "[| y \<in> pred(A,x,r);  [| y \<in> A; <y,x>:r |] ==> P |] ==> P"
by (simp add: pred_def)

lemma pred_subset_under: "pred(A,x,r) \<subseteq> r -`` {x}"
by (simp add: pred_def, blast)

lemma pred_subset: "pred(A,x,r) \<subseteq> A"
by (simp add: pred_def, blast)

lemma pred_pred_eq:
    "pred(pred(A,x,r), y, r) = pred(A,x,r) \<inter> pred(A,y,r)"
by (simp add: pred_def, blast)

lemma trans_pred_pred_eq:
    "[| trans[A](r);  <y,x>:r;  x \<in> A;  y \<in> A |]
     ==> pred(pred(A,x,r), y, r) = pred(A,y,r)"
by (unfold trans_on_def pred_def, blast)

subsection{*Restricting an Ordering's Domain*}

(** The ordering's properties hold over all subsets of its domain
    [including initial segments of the form pred(A,x,r) **)

(*Note: a relation s such that s<=r need not be a partial ordering*)
lemma part_ord_subset:
    "[| part_ord(A,r);  B<=A |] ==> part_ord(B,r)"
by (unfold part_ord_def irrefl_def trans_on_def, blast)

lemma linear_subset:
    "[| linear(A,r);  B<=A |] ==> linear(B,r)"
by (unfold linear_def, blast)

lemma tot_ord_subset:
    "[| tot_ord(A,r);  B<=A |] ==> tot_ord(B,r)"
apply (unfold tot_ord_def)
apply (fast elim!: part_ord_subset linear_subset)
done

lemma well_ord_subset:
    "[| well_ord(A,r);  B<=A |] ==> well_ord(B,r)"
apply (unfold well_ord_def)
apply (fast elim!: tot_ord_subset wf_on_subset_A)
done

(** Relations restricted to a smaller domain, by Krzysztof Grabczewski **)

lemma irrefl_Int_iff: "irrefl(A,r \<inter> A*A) \<longleftrightarrow> irrefl(A,r)"
by (unfold irrefl_def, blast)

lemma trans_on_Int_iff: "trans[A](r \<inter> A*A) \<longleftrightarrow> trans[A](r)"
by (unfold trans_on_def, blast)

lemma part_ord_Int_iff: "part_ord(A,r \<inter> A*A) \<longleftrightarrow> part_ord(A,r)"
apply (unfold part_ord_def)
apply (simp add: irrefl_Int_iff trans_on_Int_iff)
done

lemma linear_Int_iff: "linear(A,r \<inter> A*A) \<longleftrightarrow> linear(A,r)"
by (unfold linear_def, blast)

lemma tot_ord_Int_iff: "tot_ord(A,r \<inter> A*A) \<longleftrightarrow> tot_ord(A,r)"
apply (unfold tot_ord_def)
apply (simp add: part_ord_Int_iff linear_Int_iff)
done

lemma wf_on_Int_iff: "wf[A](r \<inter> A*A) \<longleftrightarrow> wf[A](r)"
apply (unfold wf_on_def wf_def, fast) (*10 times faster than blast!*)
done

lemma well_ord_Int_iff: "well_ord(A,r \<inter> A*A) \<longleftrightarrow> well_ord(A,r)"
apply (unfold well_ord_def)
apply (simp add: tot_ord_Int_iff wf_on_Int_iff)
done

subsection{*Empty and Unit Domains*}

(*The empty relation is well-founded*)
lemma wf_on_any_0: "wf[A](0)"
by (simp add: wf_on_def wf_def, fast)

subsubsection{*Relations over the Empty Set*}

lemma irrefl_0: "irrefl(0,r)"
by (unfold irrefl_def, blast)

lemma trans_on_0: "trans[0](r)"
by (unfold trans_on_def, blast)

lemma part_ord_0: "part_ord(0,r)"
apply (unfold part_ord_def)
apply (simp add: irrefl_0 trans_on_0)
done

lemma linear_0: "linear(0,r)"
by (unfold linear_def, blast)

lemma tot_ord_0: "tot_ord(0,r)"
apply (unfold tot_ord_def)
apply (simp add: part_ord_0 linear_0)
done

lemma wf_on_0: "wf[0](r)"
by (unfold wf_on_def wf_def, blast)

lemma well_ord_0: "well_ord(0,r)"
apply (unfold well_ord_def)
apply (simp add: tot_ord_0 wf_on_0)
done

subsubsection{*The Empty Relation Well-Orders the Unit Set*}

text{*by Grabczewski*}

lemma tot_ord_unit: "tot_ord({a},0)"
by (simp add: irrefl_def trans_on_def part_ord_def linear_def tot_ord_def)

lemma well_ord_unit: "well_ord({a},0)"
apply (unfold well_ord_def)
apply (simp add: tot_ord_unit wf_on_any_0)
done

subsection{*Order-Isomorphisms*}

text{*Suppes calls them "similarities"*}

(** Order-preserving (monotone) maps **)

lemma mono_map_is_fun: "f \<in> mono_map(A,r,B,s) ==> f \<in> A->B"
by (simp add: mono_map_def)

lemma mono_map_is_inj:
    "[| linear(A,r);  wf[B](s);  f \<in> mono_map(A,r,B,s) |] ==> f \<in> inj(A,B)"
apply (unfold mono_map_def inj_def, clarify)
apply (erule_tac x=w and y=x in linearE, assumption+)
apply (force intro: apply_type dest: wf_on_not_refl)+
done

lemma ord_isoI:
    "[| f \<in> bij(A, B);
        !!x y. [| x \<in> A; y \<in> A |] ==> <x, y> \<in> r \<longleftrightarrow> <f`x, f`y> \<in> s |]
     ==> f \<in> ord_iso(A,r,B,s)"
by (simp add: ord_iso_def)

lemma ord_iso_is_mono_map:
    "f \<in> ord_iso(A,r,B,s) ==> f \<in> mono_map(A,r,B,s)"
apply (simp add: ord_iso_def mono_map_def)
apply (blast dest!: bij_is_fun)
done

lemma ord_iso_is_bij:
    "f \<in> ord_iso(A,r,B,s) ==> f \<in> bij(A,B)"
by (simp add: ord_iso_def)

(*Needed?  But ord_iso_converse is!*)
lemma ord_iso_apply:
    "[| f \<in> ord_iso(A,r,B,s);  <x,y>: r;  x \<in> A;  y \<in> A |] ==> <f`x, f`y> \<in> s"
by (simp add: ord_iso_def)

lemma ord_iso_converse:
    "[| f \<in> ord_iso(A,r,B,s);  <x,y>: s;  x \<in> B;  y \<in> B |]
     ==> <converse(f) ` x, converse(f) ` y> \<in> r"
apply (simp add: ord_iso_def, clarify)
apply (erule bspec [THEN bspec, THEN iffD2])
apply (erule asm_rl bij_converse_bij [THEN bij_is_fun, THEN apply_type])+
apply (auto simp add: right_inverse_bij)
done

(** Symmetry and Transitivity Rules **)

(*Reflexivity of similarity*)
lemma ord_iso_refl: "id(A): ord_iso(A,r,A,r)"
by (rule id_bij [THEN ord_isoI], simp)

(*Symmetry of similarity*)
lemma ord_iso_sym: "f \<in> ord_iso(A,r,B,s) ==> converse(f): ord_iso(B,s,A,r)"
apply (simp add: ord_iso_def)
apply (auto simp add: right_inverse_bij bij_converse_bij
                      bij_is_fun [THEN apply_funtype])
done

(*Transitivity of similarity*)
lemma mono_map_trans:
    "[| g \<in> mono_map(A,r,B,s);  f \<in> mono_map(B,s,C,t) |]
     ==> (f O g): mono_map(A,r,C,t)"
apply (unfold mono_map_def)
apply (auto simp add: comp_fun)
done

(*Transitivity of similarity: the order-isomorphism relation*)
lemma ord_iso_trans:
    "[| g \<in> ord_iso(A,r,B,s);  f \<in> ord_iso(B,s,C,t) |]
     ==> (f O g): ord_iso(A,r,C,t)"
apply (unfold ord_iso_def, clarify)
apply (frule bij_is_fun [of f])
apply (frule bij_is_fun [of g])
apply (auto simp add: comp_bij)
done

(** Two monotone maps can make an order-isomorphism **)

lemma mono_ord_isoI:
    "[| f \<in> mono_map(A,r,B,s);  g \<in> mono_map(B,s,A,r);
        f O g = id(B);  g O f = id(A) |] ==> f \<in> ord_iso(A,r,B,s)"
apply (simp add: ord_iso_def mono_map_def, safe)
apply (intro fg_imp_bijective, auto)
apply (subgoal_tac "<g` (f`x), g` (f`y) > \<in> r")
apply (simp add: comp_eq_id_iff [THEN iffD1])
apply (blast intro: apply_funtype)
done

lemma well_ord_mono_ord_isoI:
     "[| well_ord(A,r);  well_ord(B,s);
         f \<in> mono_map(A,r,B,s);  converse(f): mono_map(B,s,A,r) |]
      ==> f \<in> ord_iso(A,r,B,s)"
apply (intro mono_ord_isoI, auto)
apply (frule mono_map_is_fun [THEN fun_is_rel])
apply (erule converse_converse [THEN subst], rule left_comp_inverse)
apply (blast intro: left_comp_inverse mono_map_is_inj well_ord_is_linear
                    well_ord_is_wf)+
done

(** Order-isomorphisms preserve the ordering's properties **)

lemma part_ord_ord_iso:
    "[| part_ord(B,s);  f \<in> ord_iso(A,r,B,s) |] ==> part_ord(A,r)"
apply (simp add: part_ord_def irrefl_def trans_on_def ord_iso_def)
apply (fast intro: bij_is_fun [THEN apply_type])
done

lemma linear_ord_iso:
    "[| linear(B,s);  f \<in> ord_iso(A,r,B,s) |] ==> linear(A,r)"
apply (simp add: linear_def ord_iso_def, safe)
apply (drule_tac x1 = "f`x" and x = "f`y" in bspec [THEN bspec])
apply (safe elim!: bij_is_fun [THEN apply_type])
apply (drule_tac t = "op ` (converse (f))" in subst_context)
apply (simp add: left_inverse_bij)
done

lemma wf_on_ord_iso:
    "[| wf[B](s);  f \<in> ord_iso(A,r,B,s) |] ==> wf[A](r)"
apply (simp add: wf_on_def wf_def ord_iso_def, safe)
apply (drule_tac x = "{f`z. z \<in> Z \<inter> A}" in spec)
apply (safe intro!: equalityI)
apply (blast dest!: equalityD1 intro: bij_is_fun [THEN apply_type])+
done

lemma well_ord_ord_iso:
    "[| well_ord(B,s);  f \<in> ord_iso(A,r,B,s) |] ==> well_ord(A,r)"
apply (unfold well_ord_def tot_ord_def)
apply (fast elim!: part_ord_ord_iso linear_ord_iso wf_on_ord_iso)
done

subsection{*Main results of Kunen, Chapter 1 section 6*}

(*Inductive argument for Kunen's Lemma 6.1, etc.
  Simple proof from Halmos, page 72*)
lemma well_ord_iso_subset_lemma:
     "[| well_ord(A,r);  f \<in> ord_iso(A,r, A',r);  A'<= A;  y \<in> A |]
      ==> ~ <f`y, y>: r"
apply (simp add: well_ord_def ord_iso_def)
apply (elim conjE CollectE)
apply (rule_tac a=y in wf_on_induct, assumption+)
apply (blast dest: bij_is_fun [THEN apply_type])
done

(*Kunen's Lemma 6.1 \<in> there's no order-isomorphism to an initial segment
                     of a well-ordering*)
lemma well_ord_iso_predE:
     "[| well_ord(A,r);  f \<in> ord_iso(A, r, pred(A,x,r), r);  x \<in> A |] ==> P"
apply (insert well_ord_iso_subset_lemma [of A r f "pred(A,x,r)" x])
apply (simp add: pred_subset)
(*Now we know  f`x < x *)
apply (drule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], assumption)
(*Now we also know @{term"f`x \<in> pred(A,x,r)"}: contradiction! *)
apply (simp add: well_ord_def pred_def)
done

(*Simple consequence of Lemma 6.1*)
lemma well_ord_iso_pred_eq:
     "[| well_ord(A,r);  f \<in> ord_iso(pred(A,a,r), r, pred(A,c,r), r);
         a \<in> A;  c \<in> A |] ==> a=c"
apply (frule well_ord_is_trans_on)
apply (frule well_ord_is_linear)
apply (erule_tac x=a and y=c in linearE, assumption+)
apply (drule ord_iso_sym)
(*two symmetric cases*)
apply (auto elim!: well_ord_subset [OF _ pred_subset, THEN well_ord_iso_predE]
            intro!: predI
            simp add: trans_pred_pred_eq)
done

(*Does not assume r is a wellordering!*)
lemma ord_iso_image_pred:
     "[|f \<in> ord_iso(A,r,B,s);  a \<in> A|] ==> f `` pred(A,a,r) = pred(B, f`a, s)"
apply (unfold ord_iso_def pred_def)
apply (erule CollectE)
apply (simp (no_asm_simp) add: image_fun [OF bij_is_fun Collect_subset])
apply (rule equalityI)
apply (safe elim!: bij_is_fun [THEN apply_type])
apply (rule RepFun_eqI)
apply (blast intro!: right_inverse_bij [symmetric])
apply (auto simp add: right_inverse_bij  bij_is_fun [THEN apply_funtype])
done

lemma ord_iso_restrict_image:
     "[| f \<in> ord_iso(A,r,B,s);  C<=A |]
      ==> restrict(f,C) \<in> ord_iso(C, r, f``C, s)"
apply (simp add: ord_iso_def)
apply (blast intro: bij_is_inj restrict_bij)
done

(*But in use, A and B may themselves be initial segments.  Then use
  trans_pred_pred_eq to simplify the pred(pred...) terms.  See just below.*)
lemma ord_iso_restrict_pred:
   "[| f \<in> ord_iso(A,r,B,s);   a \<in> A |]
    ==> restrict(f, pred(A,a,r)) \<in> ord_iso(pred(A,a,r), r, pred(B, f`a, s), s)"
apply (simp add: ord_iso_image_pred [symmetric])
apply (blast intro: ord_iso_restrict_image elim: predE)
done

(*Tricky; a lot of forward proof!*)
lemma well_ord_iso_preserving:
     "[| well_ord(A,r);  well_ord(B,s);  <a,c>: r;
         f \<in> ord_iso(pred(A,a,r), r, pred(B,b,s), s);
         g \<in> ord_iso(pred(A,c,r), r, pred(B,d,s), s);
         a \<in> A;  c \<in> A;  b \<in> B;  d \<in> B |] ==> <b,d>: s"
apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], (erule asm_rl predI predE)+)
apply (subgoal_tac "b = g`a")
apply (simp (no_asm_simp))
apply (rule well_ord_iso_pred_eq, auto)
apply (frule ord_iso_restrict_pred, (erule asm_rl predI)+)
apply (simp add: well_ord_is_trans_on trans_pred_pred_eq)
apply (erule ord_iso_sym [THEN ord_iso_trans], assumption)
done

(*See Halmos, page 72*)
lemma well_ord_iso_unique_lemma:
     "[| well_ord(A,r);
         f \<in> ord_iso(A,r, B,s);  g \<in> ord_iso(A,r, B,s);  y \<in> A |]
      ==> ~ <g`y, f`y> \<in> s"
apply (frule well_ord_iso_subset_lemma)
apply (rule_tac f = "converse (f) " and g = g in ord_iso_trans)
apply auto
apply (blast intro: ord_iso_sym)
apply (frule ord_iso_is_bij [of f])
apply (frule ord_iso_is_bij [of g])
apply (frule ord_iso_converse)
apply (blast intro!: bij_converse_bij
             intro: bij_is_fun apply_funtype)+
apply (erule notE)
apply (simp add: left_inverse_bij bij_is_fun comp_fun_apply [of _ A B])
done

(*Kunen's Lemma 6.2: Order-isomorphisms between well-orderings are unique*)
lemma well_ord_iso_unique: "[| well_ord(A,r);
         f \<in> ord_iso(A,r, B,s);  g \<in> ord_iso(A,r, B,s) |] ==> f = g"
apply (rule fun_extension)
apply (erule ord_iso_is_bij [THEN bij_is_fun])+
apply (subgoal_tac "f`x \<in> B & g`x \<in> B & linear(B,s)")
 apply (simp add: linear_def)
 apply (blast dest: well_ord_iso_unique_lemma)
apply (blast intro: ord_iso_is_bij bij_is_fun apply_funtype
                    well_ord_is_linear well_ord_ord_iso ord_iso_sym)
done

subsection{*Towards Kunen's Theorem 6.3: Linearity of the Similarity Relation*}

lemma ord_iso_map_subset: "ord_iso_map(A,r,B,s) \<subseteq> A*B"
by (unfold ord_iso_map_def, blast)

lemma domain_ord_iso_map: "domain(ord_iso_map(A,r,B,s)) \<subseteq> A"
by (unfold ord_iso_map_def, blast)

lemma range_ord_iso_map: "range(ord_iso_map(A,r,B,s)) \<subseteq> B"
by (unfold ord_iso_map_def, blast)

lemma converse_ord_iso_map:
    "converse(ord_iso_map(A,r,B,s)) = ord_iso_map(B,s,A,r)"
apply (unfold ord_iso_map_def)
apply (blast intro: ord_iso_sym)
done

lemma function_ord_iso_map:
    "well_ord(B,s) ==> function(ord_iso_map(A,r,B,s))"
apply (unfold ord_iso_map_def function_def)
apply (blast intro: well_ord_iso_pred_eq ord_iso_sym ord_iso_trans)
done

lemma ord_iso_map_fun: "well_ord(B,s) ==> ord_iso_map(A,r,B,s)
           \<in> domain(ord_iso_map(A,r,B,s)) -> range(ord_iso_map(A,r,B,s))"
by (simp add: Pi_iff function_ord_iso_map
                 ord_iso_map_subset [THEN domain_times_range])

lemma ord_iso_map_mono_map:
    "[| well_ord(A,r);  well_ord(B,s) |]
     ==> ord_iso_map(A,r,B,s)
           \<in> mono_map(domain(ord_iso_map(A,r,B,s)), r,
                      range(ord_iso_map(A,r,B,s)), s)"
apply (unfold mono_map_def)
apply (simp (no_asm_simp) add: ord_iso_map_fun)
apply safe
apply (subgoal_tac "x \<in> A & ya:A & y \<in> B & yb:B")
 apply (simp add: apply_equality [OF _  ord_iso_map_fun])
 apply (unfold ord_iso_map_def)
 apply (blast intro: well_ord_iso_preserving, blast)
done

lemma ord_iso_map_ord_iso:
    "[| well_ord(A,r);  well_ord(B,s) |] ==> ord_iso_map(A,r,B,s)
           \<in> ord_iso(domain(ord_iso_map(A,r,B,s)), r,
                      range(ord_iso_map(A,r,B,s)), s)"
apply (rule well_ord_mono_ord_isoI)
   prefer 4
   apply (rule converse_ord_iso_map [THEN subst])
   apply (simp add: ord_iso_map_mono_map
                    ord_iso_map_subset [THEN converse_converse])
apply (blast intro!: domain_ord_iso_map range_ord_iso_map
             intro: well_ord_subset ord_iso_map_mono_map)+
done

(*One way of saying that domain(ord_iso_map(A,r,B,s)) is downwards-closed*)
lemma domain_ord_iso_map_subset:
     "[| well_ord(A,r);  well_ord(B,s);
         a \<in> A;  a \<notin> domain(ord_iso_map(A,r,B,s)) |]
      ==>  domain(ord_iso_map(A,r,B,s)) \<subseteq> pred(A, a, r)"
apply (unfold ord_iso_map_def)
apply (safe intro!: predI)
(*Case analysis on  xa vs a in r *)
apply (simp (no_asm_simp))
apply (frule_tac A = A in well_ord_is_linear)
apply (rename_tac b y f)
apply (erule_tac x=b and y=a in linearE, assumption+)
(*Trivial case: b=a*)
apply clarify
apply blast
(*Harder case: <a, xa>: r*)
apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type],
       (erule asm_rl predI predE)+)
apply (frule ord_iso_restrict_pred)
 apply (simp add: pred_iff)
apply (simp split: split_if_asm
          add: well_ord_is_trans_on trans_pred_pred_eq domain_UN domain_Union, blast)
done

(*For the 4-way case analysis in the main result*)
lemma domain_ord_iso_map_cases:
     "[| well_ord(A,r);  well_ord(B,s) |]
      ==> domain(ord_iso_map(A,r,B,s)) = A |
          (\<exists>x\<in>A. domain(ord_iso_map(A,r,B,s)) = pred(A,x,r))"
apply (frule well_ord_is_wf)
apply (unfold wf_on_def wf_def)
apply (drule_tac x = "A-domain (ord_iso_map (A,r,B,s))" in spec)
apply safe
(*The first case: the domain equals A*)
apply (rule domain_ord_iso_map [THEN equalityI])
apply (erule Diff_eq_0_iff [THEN iffD1])
(*The other case: the domain equals an initial segment*)
apply (blast del: domainI subsetI
             elim!: predE
             intro!: domain_ord_iso_map_subset
             intro: subsetI)+
done

(*As above, by duality*)
lemma range_ord_iso_map_cases:
    "[| well_ord(A,r);  well_ord(B,s) |]
     ==> range(ord_iso_map(A,r,B,s)) = B |
         (\<exists>y\<in>B. range(ord_iso_map(A,r,B,s)) = pred(B,y,s))"
apply (rule converse_ord_iso_map [THEN subst])
apply (simp add: domain_ord_iso_map_cases)
done

text{*Kunen's Theorem 6.3: Fundamental Theorem for Well-Ordered Sets*}
theorem well_ord_trichotomy:
   "[| well_ord(A,r);  well_ord(B,s) |]
    ==> ord_iso_map(A,r,B,s) \<in> ord_iso(A, r, B, s) |
        (\<exists>x\<in>A. ord_iso_map(A,r,B,s) \<in> ord_iso(pred(A,x,r), r, B, s)) |
        (\<exists>y\<in>B. ord_iso_map(A,r,B,s) \<in> ord_iso(A, r, pred(B,y,s), s))"
apply (frule_tac B = B in domain_ord_iso_map_cases, assumption)
apply (frule_tac B = B in range_ord_iso_map_cases, assumption)
apply (drule ord_iso_map_ord_iso, assumption)
apply (elim disjE bexE)
   apply (simp_all add: bexI)
apply (rule wf_on_not_refl [THEN notE])
  apply (erule well_ord_is_wf)
 apply assumption
apply (subgoal_tac "<x,y>: ord_iso_map (A,r,B,s) ")
 apply (drule rangeI)
 apply (simp add: pred_def)
apply (unfold ord_iso_map_def, blast)
done

subsection{*Miscellaneous Results by Krzysztof Grabczewski*}

(** Properties of converse(r) **)

lemma irrefl_converse: "irrefl(A,r) ==> irrefl(A,converse(r))"
by (unfold irrefl_def, blast)

lemma trans_on_converse: "trans[A](r) ==> trans[A](converse(r))"
by (unfold trans_on_def, blast)

lemma part_ord_converse: "part_ord(A,r) ==> part_ord(A,converse(r))"
apply (unfold part_ord_def)
apply (blast intro!: irrefl_converse trans_on_converse)
done

lemma linear_converse: "linear(A,r) ==> linear(A,converse(r))"
by (unfold linear_def, blast)

lemma tot_ord_converse: "tot_ord(A,r) ==> tot_ord(A,converse(r))"
apply (unfold tot_ord_def)
apply (blast intro!: part_ord_converse linear_converse)
done

(** By Krzysztof Grabczewski.
    Lemmas involving the first element of a well ordered set **)

lemma first_is_elem: "first(b,B,r) ==> b \<in> B"
by (unfold first_def, blast)

lemma well_ord_imp_ex1_first:
        "[| well_ord(A,r); B<=A; B\<noteq>0 |] ==> (EX! b. first(b,B,r))"
apply (unfold well_ord_def wf_on_def wf_def first_def)
apply (elim conjE allE disjE, blast)
apply (erule bexE)
apply (rule_tac a = x in ex1I, auto)
apply (unfold tot_ord_def linear_def, blast)
done

lemma the_first_in:
     "[| well_ord(A,r); B<=A; B\<noteq>0 |] ==> (THE b. first(b,B,r)) \<in> B"
apply (drule well_ord_imp_ex1_first, assumption+)
apply (rule first_is_elem)
apply (erule theI)
done

subsection {* Lemmas for the Reflexive Orders *}

lemma subset_vimage_vimage_iff:
  "[| Preorder(r); A \<subseteq> field(r); B \<subseteq> field(r) |] ==>
  r -`` A \<subseteq> r -`` B \<longleftrightarrow> (\<forall>a\<in>A. \<exists>b\<in>B. <a, b> \<in> r)"
  apply (auto simp: subset_def preorder_on_def refl_def vimage_def image_def)
   apply blast
  unfolding trans_on_def
  apply (erule_tac P = "(\<lambda>x. \<forall>y\<in>field(?r).
          \<forall>z\<in>field(?r). \<langle>x, y\<rangle> \<in> ?r \<longrightarrow> \<langle>y, z\<rangle> \<in> ?r \<longrightarrow> \<langle>x, z\<rangle> \<in> ?r)" in rev_ballE)
    (* instance obtained from proof term generated by best *)
   apply best
  apply blast
  done

lemma subset_vimage1_vimage1_iff:
  "[| Preorder(r); a \<in> field(r); b \<in> field(r) |] ==>
  r -`` {a} \<subseteq> r -`` {b} \<longleftrightarrow> <a, b> \<in> r"
  by (simp add: subset_vimage_vimage_iff)

lemma Refl_antisym_eq_Image1_Image1_iff:
  "[| refl(field(r), r); antisym(r); a \<in> field(r); b \<in> field(r) |] ==>
  r `` {a} = r `` {b} \<longleftrightarrow> a = b"
  apply rule
   apply (frule equality_iffD)
   apply (drule equality_iffD)
   apply (simp add: antisym_def refl_def)
   apply best
  apply (simp add: antisym_def refl_def)
  done

lemma Partial_order_eq_Image1_Image1_iff:
  "[| Partial_order(r); a \<in> field(r); b \<in> field(r) |] ==>
  r `` {a} = r `` {b} \<longleftrightarrow> a = b"
  by (simp add: partial_order_on_def preorder_on_def
    Refl_antisym_eq_Image1_Image1_iff)

lemma Refl_antisym_eq_vimage1_vimage1_iff:
  "[| refl(field(r), r); antisym(r); a \<in> field(r); b \<in> field(r) |] ==>
  r -`` {a} = r -`` {b} \<longleftrightarrow> a = b"
  apply rule
   apply (frule equality_iffD)
   apply (drule equality_iffD)
   apply (simp add: antisym_def refl_def)
   apply best
  apply (simp add: antisym_def refl_def)
  done

lemma Partial_order_eq_vimage1_vimage1_iff:
  "[| Partial_order(r); a \<in> field(r); b \<in> field(r) |] ==>
  r -`` {a} = r -`` {b} \<longleftrightarrow> a = b"
  by (simp add: partial_order_on_def preorder_on_def
    Refl_antisym_eq_vimage1_vimage1_iff)

end


(*  Title:      HOL/Library/Order_Continuity.thy
    Author:     David von Oheimb, TU Muenchen
*)

section {* Continuity and iterations (of set transformers) *}

theory Order_Continuity
imports Main
begin

(* TODO: Generalize theory to chain-complete partial orders *)

lemma SUP_nat_binary:
  "(SUP n::nat. if n = 0 then A else B) = (sup A B::'a::complete_lattice)"
  apply (auto intro!: antisym SUP_least)
  apply (rule SUP_upper2[where i=0])
  apply simp_all
  apply (rule SUP_upper2[where i=1])
  apply simp_all
  done

lemma INF_nat_binary:
  "(INF n::nat. if n = 0 then A else B) = (inf A B::'a::complete_lattice)"
  apply (auto intro!: antisym INF_greatest)
  apply (rule INF_lower2[where i=0])
  apply simp_all
  apply (rule INF_lower2[where i=1])
  apply simp_all
  done

subsection {* Continuity for complete lattices *}

definition
  continuous :: "('a::complete_lattice \<Rightarrow> 'a::complete_lattice) \<Rightarrow> bool" where
  "continuous F \<longleftrightarrow> (\<forall>M::nat \<Rightarrow> 'a. mono M \<longrightarrow> F (SUP i. M i) = (SUP i. F (M i)))"

lemma continuousD: "continuous F \<Longrightarrow> mono M \<Longrightarrow> F (SUP i::nat. M i) = (SUP i. F (M i))"
  by (auto simp: continuous_def)

lemma continuous_mono:
  fixes F :: "'a::complete_lattice \<Rightarrow> 'a::complete_lattice"
  assumes [simp]: "continuous F" shows "mono F"
proof
  fix A B :: "'a" assume [simp]: "A \<le> B"
  have "F B = F (SUP n::nat. if n = 0 then A else B)"
    by (simp add: sup_absorb2 SUP_nat_binary)
  also have "\<dots> = (SUP n::nat. if n = 0 then F A else F B)"
    by (auto simp: continuousD mono_def intro!: SUP_cong)
  finally show "F A \<le> F B"
    by (simp add: SUP_nat_binary le_iff_sup)
qed

lemma continuous_lfp:
  assumes "continuous F" shows "lfp F = (SUP i. (F ^^ i) bot)" (is "lfp F = ?U")
proof (rule antisym)
  note mono = continuous_mono[OF `continuous F`]
  show "?U \<le> lfp F"
  proof (rule SUP_least)
    fix i show "(F ^^ i) bot \<le> lfp F"
    proof (induct i)
      case (Suc i)
      have "(F ^^ Suc i) bot = F ((F ^^ i) bot)" by simp
      also have "\<dots> \<le> F (lfp F)" by (rule monoD[OF mono Suc])
      also have "\<dots> = lfp F" by (simp add: lfp_unfold[OF mono, symmetric])
      finally show ?case .
    qed simp
  qed
  show "lfp F \<le> ?U"
  proof (rule lfp_lowerbound)
    have "mono (\<lambda>i::nat. (F ^^ i) bot)"
    proof -
      { fix i::nat have "(F ^^ i) bot \<le> (F ^^ (Suc i)) bot"
        proof (induct i)
          case 0 show ?case by simp
        next
          case Suc thus ?case using monoD[OF mono Suc] by auto
        qed }
      thus ?thesis by (auto simp add: mono_iff_le_Suc)
    qed
    hence "F ?U = (SUP i. (F ^^ Suc i) bot)" using `continuous F` by (simp add: continuous_def)
    also have "\<dots> \<le> ?U" by (fast intro: SUP_least SUP_upper)
    finally show "F ?U \<le> ?U" .
  qed
qed

definition
  down_continuous :: "('a::complete_lattice \<Rightarrow> 'a::complete_lattice) \<Rightarrow> bool" where
  "down_continuous F \<longleftrightarrow> (\<forall>M::nat \<Rightarrow> 'a. antimono M \<longrightarrow> F (INF i. M i) = (INF i. F (M i)))"

lemma down_continuousD: "down_continuous F \<Longrightarrow> antimono M \<Longrightarrow> F (INF i::nat. M i) = (INF i. F (M i))"
  by (auto simp: down_continuous_def)

lemma down_continuous_mono:
  fixes F :: "'a::complete_lattice \<Rightarrow> 'a::complete_lattice"
  assumes [simp]: "down_continuous F" shows "mono F"
proof
  fix A B :: "'a" assume [simp]: "A \<le> B"
  have "F A = F (INF n::nat. if n = 0 then B else A)"
    by (simp add: inf_absorb2 INF_nat_binary)
  also have "\<dots> = (INF n::nat. if n = 0 then F B else F A)"
    by (auto simp: down_continuousD antimono_def intro!: INF_cong)
  finally show "F A \<le> F B"
    by (simp add: INF_nat_binary le_iff_inf inf_commute)
qed

lemma down_continuous_gfp:
  assumes "down_continuous F" shows "gfp F = (INF i. (F ^^ i) top)" (is "gfp F = ?U")
proof (rule antisym)
  note mono = down_continuous_mono[OF `down_continuous F`]
  show "gfp F \<le> ?U"
  proof (rule INF_greatest)
    fix i show "gfp F \<le> (F ^^ i) top"
    proof (induct i)
      case (Suc i)
      have "gfp F = F (gfp F)" by (simp add: gfp_unfold[OF mono, symmetric])
      also have "\<dots> \<le> F ((F ^^ i) top)" by (rule monoD[OF mono Suc])
      also have "\<dots> = (F ^^ Suc i) top" by simp
      finally show ?case .
    qed simp
  qed
  show "?U \<le> gfp F"
  proof (rule gfp_upperbound)
    have *: "antimono (\<lambda>i::nat. (F ^^ i) top)"
    proof -
      { fix i::nat have "(F ^^ Suc i) top \<le> (F ^^ i) top"
        proof (induct i)
          case 0 show ?case by simp
        next
          case Suc thus ?case using monoD[OF mono Suc] by auto
        qed }
      thus ?thesis by (auto simp add: antimono_iff_le_Suc)
    qed
    have "?U \<le> (INF i. (F ^^ Suc i) top)"
      by (fast intro: INF_greatest INF_lower)
    also have "\<dots> \<le> F ?U"
      by (simp add: down_continuousD `down_continuous F` *)
    finally show "?U \<le> F ?U" .
  qed
qed

end


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

section \<open>Introducción a la geometría \<close>

text \<open>La geometría posee una larga de historia de estar presentada y
 representada por sistemas axiomáticos; es decir, mediante conjuntos de
 axiomas a partir del cual se pueden derivar lógicamente teoremas. Un
 axioma es una declaración que se considera verdadera, que sirve como
 punto de partida para razonamientos y argumentos adicionales.

 Por ello, vamos a representar la geometria simple, que la entenderemos
 definiendo el plano como un conjunto de puntos y las líneas como
 conjuntos de puntos, la geometría no proyectiva añadiéndole un axioma a
 la simple y por  último, la geometria proyectiva añadiendole 3 axiomas
 a la simple.

 Todo esto se definirá en Isabelle/HOL como un entorno local. Un entorno
 local o declaración local consiste en secuencia de elementos que
 declararán parámetros(\textbf{fixed}) y suposiciones
 (\textbf{assumption}).

 También de cada tipo de geometría se dará el modelo mínimo que posee
 cada una, esto se hará mediante el comando \textbf{interpretation}.
 El comando \textbf{interpretation} como su nombre indica consiste en
 interpretar los comandos locales; es decir, dar un modelo (que en este
 caso será el mínimo que ofrece cada entorno local) y probar todos los
 axiomas que este tenga.
\<close>

section \<open>Geometría simple \<close>

subsection \<open>Entorno local \<close>

text \<open>La geometría simple, como ya se ha dicho anteriormente, posee tres
 elementos fundamentales. Los puntos, el plano, que es el conjunto de
 todos ellos, y las rectas, que son conjuntos de puntos. Esta geometría
 posee 5 axiomas:
 \begin{enumerate}
  \item{El plano es no vacío.}
  \item{Toda línea es un subconjunto no vacío del plano.}
  \item{Para cualquier par de puntos en el plano, existe una línea que
    contiene a ambos.}
  \item{Dos líneas diferentes se cortan en no más de un punto.}
  \item{Para cada línea, existe un punto del plano que no pertenece a
    ella.}
 \end{enumerate}

 Se ha declarado un entorno local, denotado \textbf{Simple$-$Geometry},
 con un par de constantes (\textbf{lines} y \textbf{plane}) junto con
 los 5 axiomas anteriores.\<close>

locale Simple_Geometry =
  fixes plane :: "'a set"
  fixes lines :: "('a set) set"
  assumes A1: "plane \<noteq> {}"
      and A2: "\<forall>l \<in> lines. l \<subseteq> plane \<and> l \<noteq> {}"
      and A3: "\<forall>p \<in> plane. \<forall>q \<in> plane. \<exists>l \<in> lines. {p,q} \<subseteq> l"
      and A4: "\<forall>l \<in> lines. \<forall>r \<in> lines.
               l \<noteq> r  \<longrightarrow>  l \<inter> r = {} \<or> (\<exists>q \<in> plane. l \<inter> r = {q}) "
      and A5: "\<forall>l \<in> lines. \<exists>q \<in> plane. q \<notin> l"

text \<open>A pesar de la definición del anterior entorno local con 5 axiomas,
 no en todas las demostraciones, se van a usar todos ellos. Sin embargo,
 al haber definido tanto las líneas como el plano como conjuntos
 tenemos todas las funciones definidas en Isabelle/HOL de la teoría de
 conjuntos
  \href{https://www.cl.cam.ac.uk/research/hvg/Isabelle/dist/library/HOL/HOL/Set.html}{Set.thy}.
\<close>

subsection \<open>Proposiciones de geometría simple\<close>

text \<open>A continuación vamos a presentar una serie de lemas que vamos a
 demostrar dentro del entorno de la geometría simple.

 El primer lema es el siguiente:
 \begin{lema}\label{one-line-exists}
  Existe al menos una línea.
 \end{lema}

 \begin{demostracion}
 Vamos a demostrar que el conjunto de líneas es no vacío. Para ello,
 supongamos en primer lugar, por el axioma A1, que $q$ es un punto del
 plano. Entonces, por el axioma A3, tenemos que existe una línea $l$
 tal que $\{q,q\} \subseteq l$. Luego, ya hemos probado que existe
 una línea.
 \end{demostracion}

 La formalización del lema y su demostración en Isabelle/HOl es la
 siguiente:\<close>

lemma (in Simple_Geometry) one_line_exists:
  "\<exists>l. l \<in> lines "
proof -
  have "\<exists>q. q \<in> plane " using A1 by auto
  then obtain "q1" where "q1 \<in> plane" by (rule exE)
  then obtain "\<exists>l \<in> lines. {q1, q1} \<subseteq> l" using A3 by auto
  then show ?thesis by auto
qed

text \<open>El segundo lema es el siguiente
  \begin{lema}
    Existen al menos dos puntos que son diferentes en el plano
  \end{lema}

  \begin{demostracion}
  Para la demostración del lema, usando el lema anterior, tenemos
  que existe una línea $l$. Además, por el axioma A2, sabemos que
  $l \neq \emptyset$ lo que implica que existe un punto $q$ en $l$. Por
  otro lado, por el axioma A5, sabemos que existe un punto $p$ que
  no está en $l$. Luego ya tenemos probada la existencia de dos puntos.
  A parte, como $p \notin l$ y $q \in l$ tienen que ser distintos.
  \end{demostracion}

  La especificación y demostración del lema en Isabelle/HOL es la
  siguiente:\<close>

lemma (in Simple_Geometry) two_points_exist:
  "\<exists>p1 p2. p1 \<noteq> p2 \<and> {p1, p2} \<subseteq> plane"
proof -
  obtain "l1" where "l1 \<in> lines"
    using one_line_exists by (rule exE)
  then obtain "l1 \<subseteq> plane \<and> l1 \<noteq> {}"
    using A2 by auto
  then have "\<exists>q. q \<in> l1 \<and> q \<in> plane"
    by auto
  then obtain "p1" where "p1 \<in> l1 \<and> p1 \<in> plane"
    by (rule exE)
  moreover obtain "p2" where "p2 \<in> plane \<and> p2 \<notin> l1"
    using \<open>l1 \<in> lines\<close> A5 by auto
  ultimately show ?thesis
    by force
qed

text \<open>El siguiente lema es el siguiente:
  \begin{lema}
    Existen al menos tres puntos diferentes en el plano.
  \end{lema}

  \begin{demostracion}
  Para la demostración del lema vamos a usar el lema anterior; es decir,
  tenemos que existen dos puntos distintos $p$ y $q$. Por el axioma A3,
  se tiene que existe una línea $l$ que pasa por esos dos puntos.
  Usando el axioma A5, sabemos que existe un punto $r$ que no pertenece
  a $l$. Veamos que son diferentes; es decir, como hemos tomado
  $p \neq q$ simplemente tenemos que probar que $r \neq q$ y $r \neq p$.
  Como $r \notin l$ ya se tiene la prueba.
  \end{demostracion}

  La especificación y demostración del lema en Isabelle/HOL es la
  siguiente:\<close>

lemma (in Simple_Geometry) three_points_exist:
  "\<exists>p1 p2 p3. distinct [p1, p2, p3] \<and> {p1, p2, p3} \<subseteq> plane"
proof -
  obtain "p1" "p2"  where  "p1 \<noteq> p2 \<and> {p1, p2} \<subseteq> plane"
    using two_points_exist by auto
  moreover then obtain "l1" where "l1 \<in> lines \<and> {p1, p2} \<subseteq> l1"
    using A3 by auto
  moreover then obtain "p3" where "p3 \<in> plane \<and> p3 \<notin> l1"
    using A5 by auto
  ultimately have "distinct [p1, p2, p3] \<and> {p1, p2, p3} \<subseteq> plane"
    by auto
  then show ?thesis
    by (intro exI)
qed

text \<open>El siguiente lema es una consecuencia inmediata del lema anterior.

  \begin{lema}
    Si el plano es finito, entonces la cardinalidad del plano es mayor o
    igual que 3.
    \end{lema}

  La especificación y demostración del lema en Isabelle/HOL es la
  siguiente:\<close>

lemma (in Simple_Geometry) card_of_plane_greater:
  assumes "finite plane"
  shows "card plane \<ge> 3"
proof -
  obtain "p1" "p2" "p3" where
    "distinct [p1, p2, p3] \<and> {p1, p2, p3} \<subseteq> plane"
    using three_points_exist by auto
  moreover then have "{p1, p2, p3} \<subseteq> plane"
    by (rule conjE)
  then have "card {p1, p2, p3} \<le> card plane"
    using assms by (simp add: card_mono)
  ultimately show ?thesis
    by auto
qed

text \<open>
  \begin{lema}
    Sean $a$ y $b$ dos puntos distintos, $l$ una línea que pasa por
    ellos y $p$ un punto fuera de $l$. Sea $n$ una línea que
    pasa por $a$ y $p$ y $m$ una línea que pasa $b$ y $p$. Entonces,
    $m \neq n.$
\end{lema}

\begin{demostracion}
 La demostración se hará por reducción al absurdo; es decir, supongamos
 que $m = n$ y se llegará a un absurdo. Primero notemos que $m \neq l$
 ya que $p \notin l$ pero $p \in m,$ luego podemos aplicar el axioma A4
 a las líneas $m$ y $l.$ Al aplicarlo resulta que tenemos que $l \cap m
 = \emptyset$ o existe un punto $q$ tal que $l \cap m = \{q\}.$

 Primero supongamos que $l \cap m = \emptyset,$ sin embargo $b \in l$ y
 $b \in m$ luego hemos llegado a n absurdo.

 Segundo supongamos que sea $q$ el punto tal que $l \cap m = {q},$ sin
 embargo al principio se ha supuesto que $m = n$. Por lo tanto, se tiene
 que $\{a,b\} \subseteq \{q\}$ con lo que se ha llegado a un absurdo ya
 que $a \neq b.$

 Por los dos casos se ha llegado a un absurdo luego, $m \neq n.$
 \end{demostracion}

 Para tener una visión geométrica de la demostración incluimos la figura
 \ref{lineas_diferentes}.

\begin{figure}[H]
\centering
\includegraphics[height=6cm]{geogebra.png}
\caption{Visión geométrica de la demostración de líneas diferentes}
\label{lineas_diferentes}
\end{figure}

 La especificación y demostración del lema en Isabelle/HOL es la
 siguiente:\<close>

lemma (in Simple_Geometry) how_to_produce_different_lines:
  assumes
    "l \<in> lines"
    "{a, b} \<subseteq> l" "a \<noteq> b"
    "p \<notin> l"
    "n \<in> lines" "{a, p} \<subseteq> n"
    "m \<in> lines" "{b, p} \<subseteq> m"
  shows "m \<noteq> n"
proof (rule notI)
  assume "m = n"
  show False
  proof -
    have "m \<noteq> l"
      using assms(4, 8) by auto
    moreover have "l \<noteq> m  \<longrightarrow>  l \<inter> m = {} \<or> (\<exists>q \<in> plane. l \<inter> m = {q})"
      using assms(1, 7) A4 by auto
    ultimately have "l \<inter> m = {} \<or> (\<exists>q \<in> plane. l \<inter> m = {q})"
      by auto
    then show False
    proof (rule disjE)
      assume "l \<inter> m = {}"
      then show False
        using assms(2, 6) \<open>m = n\<close> by auto
    next
      assume "\<exists>q \<in> plane. l \<inter> m = {q}"
      then obtain "q" where "q \<in> plane \<and> l \<inter> m = {q}"
        by auto
      then have "l \<inter> m = {q}"
        by (rule conjE)
      then have "{a, b} \<subseteq> {q}"
        using assms(2, 6, 8) \<open>m = n\<close> by auto
      then show False
        using assms(3) by auto
    qed
  qed
qed

text \<open>
\begin{lema}
Sea $l$ una línea tal que existen dos puntos $\{a,b\} \subseteq l$ con
 $a \neq b,$  un punto $p$ tal que $p \notin l.$ Sea $n$ una línea tal que
$\{a,p\} \subseteq n$ y $m$ otra línea tal que $\{b,p\} \subseteq m.$
Supongamos además que existen otros dos puntos $c,d$ tales que
 pertenecen a $n$ y $m$ respectivamente y $c \neq p.$ Entonces $c \neq
 d.$
\end{lema}

\begin{demostracion}
La demostración se hará por reducción al absurdo, es decir, supongamos
 que $c = d$ y llegaremos a una contradicción. Tenemos todas las
 hipótesis del lema anterior, luego $m \neq n,$ por lo que podemos
 aplicar el axioma A4 a las líneas $m$ y $n.$ Se tiene por lo tanto que
 $m \cap n = \emptyset$ o existe un punto $q$ tal que $m \cap n = \{q\}.$

Primero supongamos que $m \cap n = \emptyset,$ sin embargo por hipótesis
se tiene que $p \in m$ y $p \in n$ luego hemos llegado a una
 contradicción.

Segundo sea $q$ el punto tal que $m \cap n = \{q\}.$ Como se ha supuesto
que $c = d$ se tiene que ${c,p} \subseteq \{q\},$ pero por hipótesis se
 tiene que $c \neq p$ luego se ha llegado a una contradicción.

En los dos caso se ha llegado a una contradicción, por lo que $c \neq d.$
\end{demostracion}

Para entender mejor la demostración se puede ver geométricamente en la
siguiente figura \ref{puntos_diferentes}

\begin{figure}[H]
\centering
\includegraphics[height=6cm]{geogebra2.png}
\caption{Visión geométrica de la demostración de puntos diferentes}
\label{puntos_diferentes}
\end{figure}

La especificación y demostración del lema en Isabelle/HOL es la siguiente:
\<close>
lemma (in Simple_Geometry) how_to_produce_different_points:
  assumes
    "l \<in> lines"
    "{a, b} \<subseteq> l" "a \<noteq> b"
    "p \<notin> l"
    "n \<in> lines" "{a, p, c} \<subseteq> n"
    "m \<in> lines" "{b, p, d} \<subseteq> m"
    "p \<noteq> c"
  shows "c \<noteq> d"
proof
  assume "c = d"
  show False
  proof -
    have "m \<noteq> n"
      using assms how_to_produce_different_lines by simp
    moreover have "n \<noteq> m  \<longrightarrow>  m \<inter> n = {} \<or> (\<exists>q \<in> plane. m \<inter> n = {q})"
      using assms(5,7) A4 by auto
    ultimately have "m \<inter> n = {} \<or> (\<exists>q \<in> plane. m \<inter> n = {q})"
      by auto
    then show False
    proof (rule disjE)
      assume "m \<inter> n = {}"
      then show False
        using assms(6, 8) by auto
    next
      assume "\<exists>q \<in> plane. m \<inter> n = {q}"
      then obtain "q" where "q \<in> plane \<and> m \<inter> n = {q}"
        by auto
      then have "{p,d} \<subseteq> {q}"
        using \<open>c = d\<close> assms by auto
      then show False
        using \<open>c = d\<close> assms(9) by auto
    qed
  qed
qed

subsection \<open>Interpretación mínimo modelo geometría simple\<close>

text \<open>
El mínimo modelo que tiene la geometría simple es considerar el plano
 como el conjunto formado por tres números $\{a,b,c\}$, ya pueden ser
 enteros,naturales etc y con ellos formar únicamente 3 líneas. En este
 caso serían las combinaciones que se pueden hacer de 2 elementos de
 un conjunto de 2, es decir, 3.

Para ello se va a dar el la definicion del \textbf{planes-3} que es el
 plano de 3 elementos y \textbf{lines-3} que es el conjunto formado por
 3 líneas.
\<close>

definition "plane_3 \<equiv> {1::nat,2,3} "

definition "lines_3 \<equiv> {{1,2},{2,3},{1,3}}"

interpretation Simple_Geometry_smallest_model:
  Simple_Geometry plane_3 lines_3
  apply standard
      apply (simp add: plane_3_def lines_3_def)+
  done

section \<open>Geometría no proyectiva \<close>

subsection \<open>Entorno local \<close>

text \<open>
La geometría no proyectiva es un tipo de geometría en el que asumimos
 paralelismo, en nuestro caso entre rectas.

\begin{definicion}
 El paralelismo es una relación que se establece entre dos rectas
 cualesquiera del plano, esta relación dice que dos rectas son paralelas
 si bien son la misma recta o no comparten ningún punto, es decir, su
 intersección es vacía.
 \end{definicion}

 Gracias a esta relación entre rectas, podemos definir un nuevo entorno
 local a\-ña\-dien\-do al ya definido \textbf{Simple-Geometry} un nuevo
 axioma, el axioma de la existencia del pa\-ra\-le\-lis\-mo.

\textbf{Parallels-Ex}: sea $p$ un punto del plano y $l$ una línea. Si $p
\notin l$ entonces debe existir una línea $m$ tal que $p \in m$ y $l
 \cap m = \emptyset.$

Al nuevo entorno local lo denotaremos como
 \textbf{Non-Projective-Geometry}.
\<close>

locale Non_Projective_Geometry =
  Simple_Geometry +
  assumes parallels_Ex:
    "\<forall>p \<in> plane. \<forall>l \<in> lines. p \<notin> l \<longrightarrow> (\<exists>m \<in> lines. p \<in> m \<and> m \<inter> l = {} )"

subsection \<open>Proposiciones de geometría no proyectiva \<close>

text\<open>
A continuación vamos a presentar un lema sobre geometría no proyectiva:

\begin{lema}
Es falso que todo par de líneas se cortan.
\end{lema}

\begin{demostracion}
La demostración se hará por reducción al absurso. Es decir, supongamos
que todo par de líneas se cortan.

Sea ahora $l1$ una línea obtenida por el el lema \ref{one-line-exists}.
Porr el axioma A5 obtenemos un punto $q1$ tal que $q1 \notin l1$.
Usando el axioma \textbf{Parallels-Ex} aplicado
al punto $q1$ y a la línea $l1$ obtenemos que existe una línea $m$ tal
que $q1 \in m$ y $m \cap l = \emptyset$. Por lo tanto, hemos llegado a
una contradicción ya que se ha demostrado que existen dos líneas cuya
intersección es vacía.
\end{demostracion}

La formalización y demostración en Isabelle/Hol es la siguiente:\<close>

lemma (in Non_Projective_Geometry) non_projective:
  "\<not>(\<forall>r \<in> lines. \<forall>s \<in> lines. r \<inter> s \<noteq> {})"
proof
  assume 4: "\<forall>r\<in>lines. \<forall>s\<in>lines. r \<inter> s \<noteq> {}"
  show False
  proof -
    obtain "l1" where 1: "l1 \<in> lines"
      using one_line_exists by auto
    then obtain "q1" where 2: "q1 \<in> plane \<and> q1 \<notin> l1"
      using A5 by auto
    then have "q1 \<notin> l1 \<longrightarrow> (\<exists>m \<in> lines. q1 \<in> m \<and> m \<inter> l1 = {} )"
      using 1 parallels_Ex by simp
    then obtain "m1" where 3: "m1 \<in> lines \<and> q1 \<in> m1 \<and> m1 \<inter> l1 = {}"
      using 2 by auto
    then obtain "m1 \<inter> l1 \<noteq> {}" using 1 4 by auto
    then show ?thesis using 3 by auto
  qed
qed

subsection \<open>Interpretacion modelo geometría no proyectiva \<close>

text \<open>
 El mínimo modelo de la geometría no proyectiva es considerar que el
 plano tiene 4 elementos; es decir, considerar el plano como
 $\{a,b,c,d\}$ siendo estos números enteros,naturales etc. Con estos 4
 elementos para que sea un modelo de la geometría no proyectiva hay que
 formar como mínimo 6 rectas.

Para ello vamos a dar la definicion \textbf{plane-4} que es el plano
formado por 4 elementos y \textbf{lines-4} que son las líneas asociadas
a estos elementos.\<close>

definition "plane_4 \<equiv> {1::nat, 2, 3, 4}"

definition "lines_4 \<equiv> {{1,2},{2,3},{1,3},{1,4},{2,4},{3,4}}"

interpretation Non_projective_geometry_card_4:
  Non_Projective_Geometry plane_4 lines_4
  apply standard
       apply (simp add: plane_4_def lines_4_def)+
  done

section \<open>Geometría proyectiva \<close>

subsection \<open>Entorno local \<close>

text \<open>
 La geometría proyectiva es un tipo de geometría que se basa en que dado
 cualquier par de rectas su intersección siempre es un punto.

 Para ello vamos a definir un nuevo entorno local
 \textbf{Projective-Geometry} tal que se basa en el entorno local ya
 definido \textbf{Simple-Geometry} añadiéndole dos axiomas más. Estos
 axiomas son los siguientes:

\begin{enumerate}
\item Cualquier par de líneas se cortan.
\item Toda línea tiene al menos 3 puntos.
\end{enumerate}

El nuevo entorno local es el siguiente:\<close>

locale Projective_Geometry =
  Simple_Geometry +
  assumes A6: "\<forall>l \<in> lines. \<forall>m \<in> lines. \<exists>p \<in> plane. p \<in> l \<and> p \<in> m"
      and A7: "\<forall>l \<in> lines. \<exists>x. card x = 3 \<and> x \<subseteq> l"

subsection \<open>Proposiciones de geometría proyectiva \<close>

text \<open>
A continuación vamos a demostrar una serie de lemas dentro del entorno
\textbf{Projective-Geometry}. Antes de los lemas vamos a demostrar en
Isabelle que si un conjunto $x$ tiene cardinalidad 3, entonces
está formado por 3 puntos distintos. Este pequeño lema nos ayudará en
las demostraciones de los siguientes.\<close>

lemma construct_set_of_card3:
  "card x = 3 \<Longrightarrow> \<exists> p1 p2 p3. distinct [p1,p2,p3] \<and> x = {p1,p2,p3}"
  by (metis card_eq_SucD distinct.simps(2)
      distinct_singleton list.set(1) list.set(2) numeral_3_eq_3)

text \<open>
 Los dos primeros lemas que vamos a demostrar son versiones equivalentes al
 axioma A7 ya definido y en los dos se utilizará el dicho axioma.

\begin{lema}\label{A7a}
Para todo línea $l$, existen $p1,p2,p3$ tales que
$\{p1,p2,p3\} \subseteq l$ y son distintos entre sí.
\end{lema}

\begin{demostracion}
Sea $l$ una línea cualquiera. Por el axioma A7 obtenemos que existe $x$
tal que cardinalidad $x = 3$ y que $x \subseteq l.$ Por el lema definido
anteriormente, se obtiene que existen $p1,p2,p3$ distintos entre sí y
tales que $x =\{p1,p2,p3\}$ y que $p1 \neq p2 \neq p3$.
\end{demostracion}

La formalización y demostración en Isabelle/HOL es la siguiente:\<close>
lemma (in Projective_Geometry) A7a:
  "\<forall>l \<in> lines. \<exists>p1 p2 p3. {p1, p2, p3} \<subseteq> plane \<and>
                          distinct [p1, p2, p3] \<and>
                          {p1, p2, p3} \<subseteq> l"
proof
  fix l
  assume 1: "l \<in> lines"
  show "\<exists>p1 p2 p3. {p1, p2, p3} \<subseteq> plane \<and>
                   distinct [p1, p2, p3] \<and>
                   {p1, p2, p3} \<subseteq> l"
  proof -
    obtain x where 2: "card x = 3 \<and> x \<subseteq> l"
      using 1 A7 by auto
    then have 3: "card x = 3"
      by (rule conjE)
    have "\<exists> p1 p2 p3. distinct [p1, p2, p3] \<and> x = {p1, p2, p3}"
      using 3 by (rule construct_set_of_card3)
    then obtain "p1" "p2" "p3"
      where 4 :"distinct [p1,p2,p3] \<and> x = {p1, p2, p3}"
      by auto
    obtain "l \<subseteq> plane \<and> l \<noteq> {}"
      using 1 A2  by auto
    then have
      "{p1, p2, p3} \<subseteq> plane \<and> distinct [p1, p2, p3] \<and> {p1, p2, p3} \<subseteq> l"
      using 4 2 by auto
    then show ?thesis
      by auto
  qed
qed

text \<open>
\begin{lema}\label{A7b}
Sea $l$ una linea y $p,q$ dos puntos de $l$. Entonces existe un punto
$r$ tal que $r \neq p, \, r \neq q$ y $r \in l.$
\end{lema}

\begin{demostracion}
Sea $l$ una linea y $p,q$ dos puntos tales que $\{p,q\} \subseteq l.$
 Por el axioma $A7$ se tiene que existe $x$ tal que la cardinalidad $x
 = 3$ y $x \subseteq l$. Por el lema demostrado anteriormente, se tiene
 que existen $p1,p2,p3$ distintos entre sí y tales que
 $\{p1,p2,p3\} \subseteq l$. Luego, usando las hipótesis se tiene 3
 posibilidades:
\begin{enumerate}
\item Si $p1 \notin{p,q}$ entonces ya tendríamos probado el lema.
\item Si $p2 \notin{p,q}$ entonces ya tendríamos probado el lema.
\item Si $p3 \notin{p,q}$ entonces ya tendríamos probado el lema.
\end{enumerate}

En cualquiera de los 3 casos ya se tendría probado el lema.
\end{demostracion}
La formalización y demostración en Isabelle/HOL es la siguiente:\<close>

lemma (in Projective_Geometry) A7b:
  assumes "l \<in> lines"
    "{p, q} \<subseteq> l "
  shows   "\<exists>r \<in> plane. r \<notin> {p, q} \<and> r \<in> l"
proof -
  obtain "x" where 1: "card x = 3 \<and> x \<subseteq> l"
    using assms A7 by auto
  then have "card x = 3"
    by (rule conjE)
  then have "\<exists> p1 p2 p3. distinct [p1,p2,p3] \<and> x = {p1,p2,p3}"
    by (rule construct_set_of_card3)
  then obtain "p1" "p2" "p3"
    where 2: "distinct [p1,p2,p3] \<and> x = {p1,p2,p3}"
    by auto
  have "l \<subseteq> plane \<and> l \<noteq> {}"
    using A2 assms by auto
  then have 3: "x \<subseteq> plane"
    using 1 by auto
  then have "p1 \<notin> {p,q} \<or> p2 \<notin> {p,q} \<or> p3 \<notin> {p,q}"
    using 2 by auto
  then show ?thesis
    using 1 2 3 by auto
qed

text \<open>
\begin{lema}
Para todo punto del plano existen dos líneas distintas que pasan por él.
\end{lema}

\begin{demostracion}
Sea $p$ un punto del plano cualquiera. Por el axioma $A3$ obtenemos que
existe una línea $l$ tal que $\{p,p\} \subseteq l$. Luego, por el axioma
$A5$, se obtiene un punto $r$ tal que $r \notin l$. Por lo tanto, por el
 axioma $A3$ de nuevo, se obtiene otra recta $m$ tal que $\{p,r\}
 \subseteq m$. Ya se tiene probada la existencia de las dos rectas que
 pasan por el punto $p$, para probar que son diferentes simplemente
 se usa que $r \in m$ y $r \notin l$.
\end{demostracion}

La formalización y demostración en Isabelle/HOL  es la siguiente:\<close>

lemma (in Projective_Geometry) two_lines_per_point:
  "\<forall>p \<in> plane. \<exists>l \<in> lines. \<exists>m \<in> lines. l \<noteq> m \<and> p \<in> l \<inter> m"
proof
  fix p
  assume 1: "p \<in> plane"
  show "\<exists>l \<in> lines. \<exists>m \<in> lines. l \<noteq> m \<and> p \<in> l \<inter> m"
  proof -
    obtain l where 2: "l \<in> lines \<and> {p,p} \<subseteq> l"
      using A3 1 by auto
    then obtain r where 3: "r \<notin> l \<and> r \<in> plane"
      using A5 by auto
    then obtain m where 4: "m \<in> lines \<and> {p,r} \<subseteq> m "
      using A3 1  by auto
    then have "l \<noteq> m \<and> p \<in> l \<inter> m"
      using  2 3 by auto
    then show ?thesis
      using 2 4 by auto
  qed
qed

text \<open>
Para el próximo lema se va a usar el siguiente lema auxiliar.

\begin{lema}\label{lema1}[Lema auxiliar 1]
Sea $l$ una línea y $r,s$ dos puntos tales que $\{r,s\} \subseteq l.$
 Sea también $l2$ otra línea y $p$ otro punto tal que $\{p,r\} \subseteq
l2$. Entonces, si $p \neq r$ y $s \notin l2$ se tiene que $p \notin l$.
\end{lema}

\begin{demostracion}
La demostración se hará por reducción al absurdo; es decir, supongamos
 $p \in l$ y se llegará a una contradicción.

Supongamos que $p \in l.$ Primero obtenemos que como $s \in l$ y $s
 \notin l2$ entonces $l \neq l2$. Usando esto último, obtenemos del
 axioma $A4$ que $l \cap l2 = \emptyset$ o $\exists q$ punto tal que $l
 \cap l2 = \{q\}$
\begin{enumerate}
\item Supongamos que $l \cap l2 = \emptyset$, pero por hipótesis se
 tiene que $r \in l$ y $r \in l2$. Luego se llega a una contradicción.
\item Supongamos que existe $q$ tal que $l \cap l2 = \{q,\}$. Sin
 embargo, como hemos supuesto que $p \in l$ y, además, $r \in l$,
$r \in l2$, $p \in l2$ y $r \neq p$ se llega a una contradicción.
\end{enumerate}
En los dos casos hemos llegado a una contradicción luego se tiene que
$p \notin l.$
\end{demostracion}

La formalización y demostración en Isabelle/HOL del lema auxiliar es la
siguiente:\<close>

lemma (in Projective_Geometry) punto_no_pertenece:
  assumes "l2 \<in> lines \<and> {p,r} \<subseteq> l2"
          "l \<in> lines \<and>  {r,s} \<subseteq> l"
          "p \<noteq> r"
          "s \<notin> l2"
        shows "p \<notin> l"
proof
  assume 1:"p \<in> l"
  have "l \<inter> l2 = {} \<or> (\<exists>q \<in> plane. l \<inter> l2 = {q})"
    using A4 assms(1,2,4) by auto
  then show False
  proof
    assume "l \<inter> l2 = {}"
    then show False
      using assms(1,2) by auto
  next
    assume " \<exists>q\<in>plane. l \<inter> l2 = {q}"
    then obtain "t" where "l \<inter> l2 = {t}"
      by auto
    then have "{p,r} \<subseteq> {t}"
      using assms(1,2) 1  by auto
    then show False
      using assms(3) by auto
  qed
qed

text \<open>El lema a demostrar es el siguiente:

\begin{lema}\label{external_line}
Para todo punto $p$ existe una línea $l$ tal que $p \notin l.$
\end{lema}

\begin{demostracion}
Sea $p$ un punto cualquiera, por el axioma $A3$ obtenemos una línea $l1$
 tal que $\{p,p\} \subseteq l1$. Usando el axioma $A5$ se obtiene un
 punto $r$ tal que $r \notin l1$. De nuevo usando el axioma $A3$
 obtenemos una línea $l2$ tal que $\{p,r\} \subseteq l2$. Repitiendo el
 mismo razonamiento, usamos el axioma $A5$ para obtener un punto $s$ tal
que $s \notin l2$ y por el axioma $A3$ una línea $l$ tal que $\{r,s\}
 \subseteq l$. Por último, usando que $r \notin l1$ se tiene que $p \neq
 r$ y, por lo tanto, se tienen todas las hipótesis del lema auxiliar
 \ref{lema1}, luego se ha demostrado que existe una línea $l$
 tal que $p \notin l.$
\end{demostracion}

La formalizacion y demostración en Isabelle/HOL es la siguiente:\<close>

lemma (in Projective_Geometry) external_line:
  "\<forall>p \<in> plane. \<exists>l \<in> lines. p \<notin> l"
proof
  fix p
  assume 1: "p \<in> plane"
  show "\<exists>l \<in> lines. p \<notin> l"
  proof -
    obtain l1 where 2: "l1 \<in> lines \<and> {p,p} \<subseteq> l1"
      using 1 A3 by auto
    then obtain r where 3: "r \<in> plane \<and> r \<notin> l1"
      using A5 by auto
    obtain l2 where 4: "l2 \<in> lines \<and> {p,r} \<subseteq> l2"
      using 1 3 A3 by auto
    then obtain s where 5: "s \<in> plane \<and> s \<notin> l2"
      using A5 3 by auto
    obtain l where 6: "l \<in> lines \<and> {r,s} \<subseteq> l"
      using 3 5 A3 by auto
    have "p \<noteq> r" using 2 3 by auto
    then have "p \<notin> l"
      using 4 6 5 punto_no_pertenece [of l2 p r l s] by simp
    then show ?thesis
      using 6 by auto
  qed
qed

text \<open>
Para el próximo lema, se va a usar el siguiente lema auxiliar:

\begin{lema}\label{lineas_diferentes}
Sean $l,l1,l2$ líneas tales que existen puntos $p,q,r$ tal que $\{p,r\}
 \subseteq l, \, \{p,q\} \subseteq l1 \, \{r,q\} \subseteq l2$ y,
 además, $l \neq l1$ y $p \neq r.$ Entonces se tiene que $l1 \neq l2.$
\end{lema}

\begin{demostracion}
La demostración se hará por reducción al absurdo, es decir, supongamos
 que $l1 = l2$ y se llegará a una contradicción.

Supongamos que $l1 = l2.$ Como por hipótesis se tiene que $l \neq l1$
 entonces usando el axioma $A4$ obtenemos que $l \cap l1 = \emptyset$ o
 existe un punto tal que $l \cap l1 = \emptyset$. Veamos los dos casos.

\begin{enumerate}
\item Supongamos que $l \cap l1 = \emptyset$. Como por hipótesis se
 tiene que $p \in l$ y $p \in l1$ entonces se llega a un absurdo.
\item Supongamos que existe un punto $t$ tal que $l \cap l1 = \{t\}$.
Como se había supuesto que $l1 = l2$ se tiene que, usando las hipótesis,
 $\{p,r\} \subseteq \{t,\}$. Sin embargo, como $p \neq r$ entonces se
 llega a un absurdo.
\end{enumerate}

En ambos casos hemos llegado a un absurdo, luego $l1 \neq l2.$
\end{demostracion}

Su demostración y formalización en Isabelle/HOL es la siguiente:\<close>

lemma (in Projective_Geometry) lineas_diferentes:
  assumes "l \<in> lines \<and> {p,r} \<subseteq> l"
          "l1 \<in> lines \<and> {p,q} \<subseteq> l1"
          "l2 \<in> lines \<and> {r,q} \<subseteq> l2"
          "l1 \<noteq> l "
          "p \<noteq> r"
  shows   "l1 \<noteq> l2"
proof
  assume 1:"l1 = l2"
  have "l \<inter> l1 = {} \<or> (\<exists>q \<in> plane. l \<inter> l1 = {q})"
    using A4 assms(1,2,4) by auto
  then show False
  proof
    assume "l \<inter> l1 = {}"
    then show False
      using assms(1,2) by auto
  next
    assume "\<exists>q\<in>plane. l \<inter> l1 = {q}"
    then obtain t where "l \<inter> l1 = {t}"
      by auto
    then have "{p,r} \<subseteq> {t}"
      using assms(1,2,3) 1 by auto
    then show False
      using assms(5) by auto
  qed
qed

text \<open>
\begin{lema}\label{3lineas_diferentes}
Para todo punto $p$ en el plano, existen al menos tres líneas que pasan
por $p$.
\end{lema}

\begin{demostracion}
Sea $p$ un punto del plano, usando el lema \ref{external_line} se
 obitene que una línea $h$ tal que $p \notin h$. Usando la
 definición equivalente del axioma $A7$ (lema \ref{A7a}) se obtienen
 tres puntos $a,b,c$ distintos entre sí y tales que
 $\{a,b,c\} \subseteq h$. Por lo tanto, usando el axioma $A3$ obtenemos
 de forma equivalente tres líneas $l,m,n$ tales que
 $\{a,p\} \subseteq l, \, \{b,p\} \subseteq m,\, \{c,p\} \subseteq n$.
 Ya hemos probado que existen $3$ líneas que
 verifican las condiciones, lo único que queda por probar es que sean
 diferente. Usando el lema auxiliar \ref{lineas_diferentes} se
 concluye la prueba.
\end{demostracion}

La siguiente figura \ref{3lineas_diferentes} muestra una visión
 geométrica de la demostración anterior.
\begin{figure}[H]
\centering
\includegraphics[height=6cm]{geogebra3.png}
\caption{Visión geométrica de la demostración del lema
 \ref{3lineas_diferentes}}
\label{3lineas_diferentes}
\end{figure}

La formalización y demostración en Isabelle/HOL es la siguiente:\<close>

lemma (in Projective_Geometry) three_lines_per_point:
  "\<forall>p \<in> plane. \<exists>l m n.
    distinct [l,m,n] \<and> {l,m,n} \<subseteq> lines \<and> p \<in> l \<inter> m \<inter> n"
proof
  fix p
  assume 1: "p \<in> plane"
  show "\<exists>l m n. distinct [l,m,n] \<and> {l,m,n} \<subseteq> lines \<and> p \<in> l \<inter> m \<inter> n"
  proof -
    obtain h where 2: "h \<in> lines \<and> p \<notin> h"
      using 1 external_line by auto
    then obtain a b c
      where 3: "{a,b,c} \<subseteq> plane \<and> distinct [a,b,c] \<and> {a,b,c} \<subseteq> h"
      using A7a by auto
    then obtain l where 4: "l \<in> lines \<and> {a,p} \<subseteq> l"
      using 1 A3 by auto
    obtain m  where 5: "m \<in> lines \<and> {b,p} \<subseteq> m"
      using 1 3 A3 by auto
    obtain n where 6: "n \<in> lines \<and> {c,p} \<subseteq> n"
      using 1 3 A3 by auto
    have 7:"h \<noteq> l"
      using 4 2 by auto
    have "a \<noteq> b"
      using 3 by auto
    then have 9: "m \<noteq> l"
      using 3 4 5 2 7 lineas_diferentes [of h a b l p m ] by simp
    have 8: "h \<noteq> m"
      using 5 2 by auto
    have  "b \<noteq> c"
      using 3 by auto
    then have 10: "m \<noteq> n"
      using 6 5 3 2 8 lineas_diferentes [of h b c m p n ] by simp
    have "a \<noteq> c"
      using 3 by auto
    then  have 11: "l \<noteq> n"
      using 2 3 4 6 7 lineas_diferentes [of h a c l p n ] by simp
    show ?thesis
      using  4 5 6 9 10 11 by auto
  qed
qed

text \<open>
Para el siguiente lema se va a usar el siguiente lema auxiliar:

\begin{lema}\label{puntos_diferentes}
Sea $l$ y $l1$ líneas tales que $l \neq l1$ y existen puntos $p,q,c$
tales que $\{p,c\} \subseteq l$ y $\{q,c\} \subseteq l1$ con
$c \neq p$. Entonces $p \neq q$
\end{lema}

\begin{demostracion}
La demostración se hará por reducción al absurdo, es decir, supongamos
 que $p = q$ y se llegará a un absurdo.

Supongamos que $p = q.$ Entonces usando la hipótesis $l \neq l1$ y el
 axioma $A4$ se obtiene que $l \cap l1 = \emptyset$ o existe un punto
 tal que $l \cap l1 = \{q\}.$ Veamos los dos casos por separado.

\begin{enumerate}
\item Supongamos que $l \cap l1 = \emptyset.$ Como por hipótesis se
 tiene que $c \in l$ y $c \in l1$ entonces se llega a un contradicción.
\item Supongamos que existe $t$ tal que $l \cap l1 = \{t\}$. Sin
 embargo, como hemos supuesto que $p = q$, se tiene que $\{p,c\}
 \subseteq \{t\}$. Pero como $p \neq c$ se llega a una contradicción.
\end{enumerate}

En los dos casos se ha llegado a una contradicción luego se tiene que
$p \neq q.$
\end{demostracion}

La formalización y demostración en Isabelle/HOL es la siguiente:\<close>
lemma (in Projective_Geometry) puntos_diferentes:
  assumes "l \<in> lines"
          "l1 \<in> lines"
          "{p,c} \<subseteq> l"
          "{q,c} \<subseteq> l1"
          "l \<noteq> l1"
          "c \<noteq> p"
        shows "p \<noteq> q"
proof
  assume 1: "p = q"
  have "l \<inter> l1 = {} \<or> (\<exists>q \<in> plane. l \<inter> l1 = {q})"
    using assms(1,2,5) A4 by auto
  then show False
  proof
    assume "l \<inter> l1 = {}"
    then show False
      using assms(3,4) by auto
  next
    assume "\<exists>q\<in>plane. l \<inter> l1 = {q}"
    then obtain t where "l \<inter> l1 = {t}"
      by auto
    then have "{p,c} \<subseteq> {t}"
      using assms(3,4) 1 by auto
    then show False
      using assms(6) by auto
  qed
qed

text \<open>
\begin{lema}\label{7_puntos}
Existen al menos 7 puntos diferenetes en el plano.
\end{lema}

\begin{demostracion}
Primero sea $l$ una línea que se obtiene usando el lema
 \ref{one-line-exists}, usando el lema equivalente al axioma $A7$ (lema
 \ref{A7a} ) se obtienen $3$ puntos $p1,p2,p3$ distintos entre sí tales
 que $\{p1,p2,p3\} \subseteq l$. Ahora usando el axioma $A5$ se
 obtiene que existe $q$ tal que $q \notin l$, luego ya se tienen
 probado que existen $4$ puntos diferentes, ya que $q$ es diferente del
 resto porque $q \notin l$.  Consideremos ahora tres líneas $l1,l2,l3$
 obtenidas por el axioma $A3$ tales que $\{p1,q\} \subseteq l1, \,
 \{p2,q\} \subseteq l2, \, \{p3,q\} \subseteq l3.$ Ahora vamos a obtener
los tres puntos restantes, usando que $l \neq l1 \neq l2 \neq l3$
gracias al lema auxiliar \ref{lineas_diferentes}:

\begin{enumerate}
\item Obtenemos $p4$ tal que $p4 \in l1$ y $p4 \notin \{p1,q\}$
 usando el lema equivalente al axioma $A7$ (lema \ref{A7b}). Entonces
 veamos que $p4$ es diferente al resto de los puntos. Se tiene que $p4
 \notin \{p1,q\},$ luego veamos que $p4 \neq p2$ y $p4 \neq p3.$ Usando
 el lema auxiliar \ref{puntos_diferentes} se tiene probado. Luego hemos
 probado que $p4$ es diferente al resto de los puntos.

\item Obtenemos $p5$ tal que $p5 \in l2$ y $p5 \notin \{p2,q\}$
 usando el lema equivalente al axioma $A7$ (lema \ref{A7b}). Entonces
 veamos que $p5$ es diferente al resto de los puntos, ya se tiene que
 $p5 \notin \{p2,q\}$ luego falta por probar que $p5 \notin
 \{p1,p3,p4\}.$ Sin embargo es inmediato comprobar que se verifica
 usando el lema auxiliar \ref{puntos_diferente}, luego ya hemos probado
 que $p5$ es diferente al resto de los puntos.

\item Obtenemos $p6$ tal que $p6 \in l3$ y $p6 \notin \{p3,q\}$
 usando el lema equivalente al axioma $A7$ (lema \ref{A7b}). Entonces
 veamos que $p6$ es diferente al resto de los puntos, ya se tiene que
 $p6 \notin \{p3,q\}$ luego falta por probar que $p6 \notin
 \{p1,p2,p4,p5\}.$ Sin embargo es inmediato comprobar que se verifica
 usando el lema auxiliar \ref{puntos_diferente}, luego ya hemos probado
 que $p6$ es diferente al resto de los puntos.
\end{enumerate}

Por lo tanto, ya tenemos probado la existencia y  la disparidad de $7$
 puntos: $\{p1,p2,p3,p4,p5,p6,p7\}.$
\end{demostracion}

La siguiente figura \ref{7_puntosdiferentes} muestra una intuición geométrica de
la demostración del lema \ref{7_puntos}.

\begin{figure}[H]
\centering
\includegraphics[height=6cm]{geogebra4.png}
\caption{Visión geométrica de la demostración del lema \ref{7_puntos}}
\label{7_puntosdiferentes}
\end{figure}

La formalización y demostración del lema en Isabelle/HOL es la
 siguiente:\<close>

lemma (in Projective_Geometry) at_least_seven_points:
  "\<exists>p1 p2 p3 p4 p5 p6 p7.
    distinct [p1,p2,p3,p4,p5,p6,p7] \<and> {p1,p2,p3,p4,p5,p6,p7} \<subseteq> plane"
proof -
  obtain l where 1: "l \<in> lines"
    using one_line_exists by auto
  then obtain x where 2: "card x = 3 \<and> x \<subseteq> l"
    using A7 by auto
  then have "card x = 3"
    by (rule conjE)
  then obtain p1 p2 p3
    where 3: "distinct [p1,p2,p3] \<and> x = {p1,p2,p3}"
    using construct_set_of_card3 [of x] by auto
  then have 4: "{p1,p2,p3} \<subseteq> l"
    using 2 by auto
  then have 5: "{p1,p2,p3} \<subseteq> plane"
    using A2 1 by auto
  obtain q where 6: "q \<in> plane \<and> q \<notin> l"
    using A5 1 by auto
  then have 7: "distinct [p1,p2,p3,q]"
    using 3 4 by auto
  obtain l1 where 8: "l1 \<in> lines \<and> {p1,q} \<subseteq> l1"
    using 5 6 A3 by auto
  then have 9: "l1 \<noteq> l"
    using 6 by auto
  obtain p4 where 10: "p4 \<notin> {p1,q} \<and> p4 \<in> l1"
    using A7b [of l1 p1 q] 8 by auto
  have 11: "p4 \<noteq> p2"
    using 3 4 1 6 2 10 8 puntos_diferentes [of l1 l p4 p1 p2] by auto
  have 12: "p4 \<noteq> p3"
    using 7 1 9 4 10 8 puntos_diferentes [of l1 l p4 p1 p3] by auto
  obtain l2 where 13: "l2 \<in> lines \<and> {p2,q} \<subseteq> l2"
    using 5 6 A3 by auto
  then obtain p5 where 14: "p5 \<notin> {p2,q} \<and> p5 \<in> l2"
    using A7b [of l2 p2 q] 7 by auto
  have 15: "l2 \<noteq> l"
    using 6 13 by auto
  have 16: "p5 \<noteq> p1"
    using 1 13 14 4  15 puntos_diferentes [of l l2 p1 p2  p5]
    by auto
  have 17: "p5 \<noteq> p3"
    using 1 13 14 4  15 puntos_diferentes [of l l2 p3 p2 p5]
    by auto
  have 20: "l1 \<noteq> l2 "
    using 1 9 13 4 8 7 lineas_diferentes [of l p1 p2 l1 q l2 ]
    by simp
  have 21: "p4 \<noteq> p5"
    using 13 8 14 4 10 20 puntos_diferentes [of l1 l2 p4 q p5]
    by auto
  obtain l3 where 22: "l3 \<in> lines \<and> {p3,q} \<subseteq> l3"
    using A3 5 6 by auto
  then obtain p6 where 23: "p6 \<notin> {p3,q} \<and> p6 \<in> l3"
    using A7b by metis
  have 25: "p6 \<noteq> p1"
    using 1 22 6 4  23 puntos_diferentes [of l3 l p1 p3 p6]
    by auto
  have 26: "p6 \<noteq> p2"
    using 1 22 6 23 4 puntos_diferentes [of l3 l p2 p3 p6]
    by auto
  have 29: "l1 \<noteq> l3"
    using 1 4 9 22 8 7 lineas_diferentes [of l p1 p3 l1 q l3]
    by simp
  have 31: "p6 \<noteq> p4"
    using 22 8 10 23  29 puntos_diferentes [of l1 l3 p4 q p6]
    by auto
  have 34: "l2 \<noteq> l3"
    using 1 4 13 22 15 7 lineas_diferentes [of l p2 p3 l2 q l3]
    by simp
  have 35: "p6 \<noteq> p5"
    using 22 13 23 14 34 puntos_diferentes [of l2 l3 p5 q p6]
    by auto
  moreover have "distinct [p1,p2,p3,p4,p5,p6,q]"
    using 7 10 11 12 14 16 17 21 23 25 26 31 7 35 by auto
  moreover have "{p1,p2,p3,p4,p5,p6,q} \<subseteq> plane"
    using 6 5  A2 10 8 14 13 22 23 by auto
  ultimately show ?thesis
    by blast
qed

subsection \<open>Interpretación modelo geometría proyectiva \<close>

text \<open>
El mínimo modelo que presenta la Geometria Proyectiva es considerar que
 el plano tiene $7$ puntos y con ellos formar como mínimo $7$ líneas.
 Este modelo se conoce como el \textbf{plano de Fano} que es el plano
proyectivo con el menor número de puntos y líneas necesarios para que
se verifiquen todos los axiomas. Para ello vamos a
 dar la definición en Isabelle del plano de 7 elementos
 \textbf{plane-7} y la definición \textbf{lines-7} asociado a sus 7
 líneas.

La siguiente figura \ref{proyectivo} muestra una visión del
\textbf{plano de Fano}:

\begin{figure}[H]
\centering
\includegraphics[height=6cm]{proyectivo.png}
\caption{Visión geométrica del plano de Fano}
\label{proyectivo}
\end{figure}

\<close>
definition "plane_7 \<equiv> {1::nat,2,3,4,5,6,7}"

definition "lines_7 \<equiv> {{1,2,3},{1,6,5},{3,4,5},{5,7,2},{3,7,6},
                        {1,4,7},{2,4,6}}"

text \<open>
Para poder demostrar la existencia de este modelo mínimo con el comando
 \textbf{interpretation} es necesario definir los siguientes lemas
 auxiliares:
\<close>
lemma aux1a: "card {Suc 0, 2, 3} = 3"
  by auto

lemma aux1: "\<exists>x. card x = 3 \<and> x \<subseteq> {Suc 0, 2, 3}"
  using aux1a by blast

lemma aux2a: "card {Suc 0, 6, 5} = 3"
  by auto

lemma aux2: "\<exists>x. card x = 3 \<and> x \<subseteq> {Suc 0, 6, 5}"
  using aux2a by blast

lemma aux3a: "card {3::nat, 4, 5} = 3"
  by auto

lemma aux3: "\<exists>x. card x = 3 \<and> x \<subseteq> {3::nat, 4, 5}"
  using aux3a by blast

lemma aux4a: "card {5::nat, 7, 2} = 3"
  by auto

lemma aux4: "\<exists>x. card x = 3 \<and> x \<subseteq> {5::nat, 7, 2}"
  using aux4a by blast

lemma aux5a: "card {3::nat, 7, 6} = 3"
  by auto

lemma aux5: "\<exists>x. card x = 3 \<and> x \<subseteq> {3::nat, 7, 6}"
  using aux5a by blast

lemma aux6a: "card {Suc 0, 4, 7} = 3"
  by auto

lemma aux6: "\<exists>x. card x = 3 \<and> x \<subseteq> {Suc 0, 4, 7}"
  using aux6a by blast

lemma aux7a: "card {2::nat, 4, 6} = 3"
  by auto

lemma aux7: "\<exists>x. card x = 3 \<and> x \<subseteq> {2::nat, 4, 6}"
  using aux7a by blast

interpretation Projective_Geometry_smallest_model:
  Projective_Geometry plane_7 lines_7
  apply standard
        apply (simp add: plane_7_def lines_7_def)+
  apply (intro conjI)
  apply (rule aux1)
  apply (rule aux2)
  apply (rule aux3)
  apply (rule aux4)
  apply (rule aux5)
  apply (rule aux6)
  apply (rule aux7)
  done

end


header {* Arctan Upper and Lower Bounds *}

theory Atan_CF_Bounds
imports Bounds_Lemmas
        "~~/src/HOL/Library/Sum_of_Squares"

begin

text{*Covers all bounds used in arctan-upper.ax, arctan-lower.ax and arctan-extended.ax,
excepting only arctan-extended2.ax, which is used in two atan-error-analysis problems.*}

section {*Upper Bound 1*}

definition arctan_upper_11 :: "real \<Rightarrow> real"
  where "arctan_upper_11 \<equiv> \<lambda>x. -(pi/2) - 1/x"

definition diff_delta_arctan_upper_11 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_11 \<equiv> \<lambda>x. 1 / (x^2 * (1 + x^2))"

lemma d_delta_arctan_upper_11_pos: "x \<noteq> 0 \<Longrightarrow> diff_delta_arctan_upper_11 x > 0"
unfolding diff_delta_arctan_upper_11_def
by (simp add: divide_simps zero_less_mult_iff add_pos_pos)

text{*Different proof needed here: they coincide not at zero, but at (-) infinity!*}

lemma arctan_upper_11:
  assumes "x < 0"
    shows "arctan(x) < arctan_upper_11 x"
proof -
  have "((\<lambda>x. arctan_upper_11 x - arctan x) ---> - (pi / 2) - 0 - (- (pi / 2))) at_bot"
    unfolding arctan_upper_11_def
    apply (intro tendsto_intros tendsto_arctan_at_bot, auto simp: ext [OF divide_inverse])
    apply (metis tendsto_inverse_0 at_bot_le_at_infinity tendsto_mono)
    done
  then have *: "((\<lambda>x. arctan_upper_11 x - arctan x) ---> 0) at_bot"
    by simp
  have "0 < arctan_upper_11 x - arctan x"
    apply (rule DERIV_pos_imp_increasing_at_bot [OF _ *])
    apply (metis assms d_delta_arctan_upper_11 d_delta_arctan_upper_11_pos not_le)
    done
  then show ?thesis
    by auto
qed

definition arctan_upper_12 :: "real \<Rightarrow> real"
  where "arctan_upper_12 \<equiv> \<lambda>x. 3*x / (x^2 + 3)"

definition diff_delta_arctan_upper_12 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_12 \<equiv> \<lambda>x. -4*x^4 / ((x^2+3)^2 * (1+x^2))"

lemma d_delta_arctan_upper_12:
     "((\<lambda>x. arctan_upper_12 x - arctan x) has_field_derivative diff_delta_arctan_upper_12 x) (at x)"
  unfolding arctan_upper_12_def diff_delta_arctan_upper_12_def
  using assms
  apply (intro derivative_eq_intros,  simp_all)
  apply (auto simp: divide_simps add_nonneg_eq_0_iff, algebra)
  done

text{*Strict inequalities also possible*}
lemma arctan_upper_12:
  assumes "x \<le> 0" shows "arctan(x) \<le> arctan_upper_12 x"
apply (rule gen_upper_bound_decreasing [OF assms d_delta_arctan_upper_12])
apply (auto simp: diff_delta_arctan_upper_12_def arctan_upper_12_def)
done

definition arctan_upper_13 :: "real \<Rightarrow> real"
  where "arctan_upper_13 \<equiv> \<lambda>x. x"

definition diff_delta_arctan_upper_13 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_13 \<equiv> \<lambda>x. x^2 / (1 + x^2)"

lemma d_delta_arctan_upper_13:
    "((\<lambda>x. arctan_upper_13 x - arctan x) has_field_derivative diff_delta_arctan_upper_13 x) (at x)"
unfolding arctan_upper_13_def diff_delta_arctan_upper_13_def
apply (intro derivative_eq_intros, simp_all)
apply (simp add: divide_simps add_nonneg_eq_0_iff)
done

lemma arctan_upper_13:
  assumes "x \<ge> 0" shows "arctan(x) \<le> arctan_upper_13 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_arctan_upper_13])
apply (auto simp: diff_delta_arctan_upper_13_def arctan_upper_13_def)
done

definition arctan_upper_14 :: "real \<Rightarrow> real"
  where "arctan_upper_14 \<equiv> \<lambda>x. pi/2 - 3*x / (1 + 3*x^2)"

definition diff_delta_arctan_upper_14 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_14 \<equiv> \<lambda>x. -4 / ((1 + 3*x^2)^2 * (1+x^2))"

lemma d_delta_arctan_upper_14:
  "((\<lambda>x. arctan_upper_14 x - arctan x) has_field_derivative diff_delta_arctan_upper_14 x) (at x)"
unfolding arctan_upper_14_def diff_delta_arctan_upper_14_def
apply (intro derivative_eq_intros | simp add: add_nonneg_eq_0_iff)+
apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
done

lemma d_delta_arctan_upper_14_neg: "diff_delta_arctan_upper_14 x < 0"
unfolding diff_delta_arctan_upper_14_def
apply (auto simp: divide_simps add_nonneg_eq_0_iff zero_less_mult_iff)
using power2_less_0 [of x]
apply arith
done

lemma lim14: "((\<lambda>x::real. 3 * x / (1 + 3 * x\<^sup>2)) ---> 0) at_infinity"
  apply (rule tendsto_0_le [where f = inverse and K=1])
  apply (metis tendsto_inverse_0)
  apply (simp add: eventually_at_infinity)
  apply (rule_tac x=1 in exI)
  apply (simp add: power_eq_if abs_if divide_simps add_sign_intros)
  done

text{*Different proof needed here: they coincide not at zero, but at (+) infinity!*}

lemma arctan_upper_14:
  assumes "x > 0"
    shows "arctan(x) < arctan_upper_14 x"
proof -
  have "((\<lambda>x. arctan_upper_14 x - arctan x) ---> pi / 2 - 0 - pi / 2) at_top"
    unfolding arctan_upper_14_def
    apply (intro tendsto_intros tendsto_arctan_at_top)
    apply (auto simp: tendsto_mono [OF at_top_le_at_infinity lim14])
    done
  then have *: "((\<lambda>x. arctan_upper_14 x - arctan x) ---> 0) at_top"
    by simp
  have "0 < arctan_upper_14 x - arctan x"
    apply (rule DERIV_neg_imp_decreasing_at_top [OF _ *])
    apply (metis d_delta_arctan_upper_14 d_delta_arctan_upper_14_neg)
    done
  then show ?thesis
    by auto
qed

section {*Lower Bound 1*}

definition arctan_lower_11 :: "real \<Rightarrow> real"
  where "arctan_lower_11 \<equiv> \<lambda>x. -(pi/2) - 3*x / (1 + 3*x^2)"

lemma arctan_lower_11:
  assumes "x < 0"
    shows "arctan(x) > arctan_lower_11 x"
    using arctan_upper_14 [of "-x"] assms
    by (auto simp: arctan_upper_14_def arctan_lower_11_def arctan_minus)

abbreviation "arctan_lower_12 \<equiv> arctan_upper_13"

lemma arctan_lower_12:
  assumes "x \<le> 0"
    shows "arctan(x) \<ge> arctan_lower_12 x"
    using arctan_upper_13 [of "-x"] assms
    by (auto simp: arctan_upper_13_def arctan_minus)

abbreviation "arctan_lower_13 \<equiv> arctan_upper_12"

lemma arctan_lower_13:
  assumes "x \<ge> 0"
    shows "arctan(x) \<ge> arctan_lower_13 x"
    using arctan_upper_12 [of "-x"] assms
    by (auto simp: arctan_upper_12_def arctan_minus)

definition arctan_lower_14 :: "real \<Rightarrow> real"
  where "arctan_lower_14 \<equiv> \<lambda>x. pi/2 - 1/x"

lemma arctan_lower_14:
  assumes "x > 0"
    shows "arctan(x) > arctan_lower_14 x"
    using arctan_upper_11 [of "-x"] assms
    by (auto simp: arctan_upper_11_def arctan_lower_14_def arctan_minus)

section {*Upper Bound 3*}

definition arctan_upper_31 :: "real \<Rightarrow> real"
  where "arctan_upper_31 \<equiv> \<lambda>x. -(pi/2) - (64 + 735*x^2 + 945*x^4) / (15*x*(15 + 70*x^2 + 63*x^4))"

definition diff_delta_arctan_upper_31 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_31 \<equiv> \<lambda>x. 64 / (x^2 * (15 + 70*x^2 + 63*x^4)^2 * (1 + x^2))"

lemma d_delta_arctan_upper_31:
  assumes "x \<noteq> 0"
    shows "((\<lambda>x. arctan_upper_31 x - arctan x) has_field_derivative diff_delta_arctan_upper_31 x) (at x)"
  unfolding arctan_upper_31_def diff_delta_arctan_upper_31_def
  using assms
  apply (intro derivative_eq_intros)
  apply (rule refl | simp add: add_nonneg_eq_0_iff)+
  apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
  done

lemma d_delta_arctan_upper_31_pos: "x \<noteq> 0 \<Longrightarrow> diff_delta_arctan_upper_31 x > 0"
unfolding diff_delta_arctan_upper_31_def
by (auto simp: divide_simps zero_less_mult_iff add_pos_pos add_nonneg_eq_0_iff)

lemma arctan_upper_31:
  assumes "x < 0"
    shows "arctan(x) < arctan_upper_31 x"
proof -
  have *: "\<And>x::real.  (15 + 70 * x\<^sup>2 + 63 * x ^ 4) > 0"
    by (sos "((R<1 + ((R<1 * ((R<7/8 * [19/7*x^2 + 1]^2) + ((R<4 * [x]^2) + (R<10/7 * [x^2]^2)))) + ((A<=0 * R<1) * (R<1/8 * [1]^2)))))")
  then have **: "\<And>x::real. \<not> (15 + 70 * x\<^sup>2 + 63 * x ^ 4) < 0"
    by (simp add: not_less)
  have "((\<lambda>x::real. (64 + 735 * x\<^sup>2 + 945 * x ^ 4) / (15 * x * (15 + 70 * x\<^sup>2 + 63 * x ^ 4))) ---> 0) at_bot"
    apply (rule tendsto_0_le [where f = inverse and K=2])
    apply (metis at_bot_le_at_infinity tendsto_inverse_0 tendsto_mono)
    apply (simp add: eventually_at_bot_linorder)
    apply (rule_tac x="-1" in exI)
    apply (auto simp: divide_simps abs_if zero_less_mult_iff **)
    done
  then have "((\<lambda>x. arctan_upper_31 x - arctan x) ---> - (pi / 2) - 0 - (- (pi / 2))) at_bot"
    unfolding arctan_upper_31_def
    apply (intro tendsto_intros tendsto_arctan_at_bot, auto)
    done
  then have *: "((\<lambda>x. arctan_upper_31 x - arctan x) ---> 0) at_bot"
    by simp
  have "0 < arctan_upper_31 x - arctan x"
    apply (rule DERIV_pos_imp_increasing_at_bot [OF _ *])
    apply (metis assms d_delta_arctan_upper_31 d_delta_arctan_upper_31_pos not_le)
    done
  then show ?thesis
    by auto
qed

definition arctan_upper_32 :: "real \<Rightarrow> real"
  where "arctan_upper_32 \<equiv> \<lambda>x. 7*(33*x^4 + 170*x^2 + 165)*x / (5*(5*x^6 + 105*x^4 + 315*x^2 + 231))"

definition diff_delta_arctan_upper_32 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_32 \<equiv> \<lambda>x. -256*x^12 / ((5*x^6+105*x^4+315*x^2+231)^2*(1+x^2))"

lemma d_delta_arctan_upper_32:
    "((\<lambda>x. arctan_upper_32 x - arctan x) has_field_derivative diff_delta_arctan_upper_32 x) (at x)"
    unfolding arctan_upper_32_def diff_delta_arctan_upper_32_def
    apply (intro derivative_eq_intros | simp)+
    apply simp_all
    apply (auto simp: add_nonneg_eq_0_iff divide_simps, algebra)
    done

lemma arctan_upper_32:
  assumes "x \<le> 0" shows "arctan(x) \<le> arctan_upper_32 x"
apply (rule gen_upper_bound_decreasing [OF assms d_delta_arctan_upper_32])
apply (auto simp: diff_delta_arctan_upper_32_def arctan_upper_32_def)
done

definition arctan_upper_33 :: "real \<Rightarrow> real"
  where "arctan_upper_33 \<equiv> \<lambda>x. (64*x^4+735*x^2+945)*x / (15*(15*x^4+70*x^2+63))"

definition diff_delta_arctan_upper_33 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_33 \<equiv> \<lambda>x. 64*x^10 / ((15*x^4+70*x^2+63)^2*(1+x^2))"

lemma d_delta_arctan_upper_33:
    "((\<lambda>x. arctan_upper_33 x - arctan x) has_field_derivative diff_delta_arctan_upper_33 x) (at x)"
unfolding arctan_upper_33_def diff_delta_arctan_upper_33_def
apply (intro derivative_eq_intros, simp_all)
apply (auto simp: add_nonneg_eq_0_iff divide_simps, algebra)
done

lemma arctan_upper_33:
  assumes "x \<ge> 0" shows "arctan(x) \<le> arctan_upper_33 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_arctan_upper_33])
apply (auto simp: diff_delta_arctan_upper_33_def arctan_upper_33_def)
done

definition arctan_upper_34 :: "real \<Rightarrow> real"
  where "arctan_upper_34 \<equiv>
         \<lambda>x. pi/2 - (33 + 170*x^2 + 165*x^4)*7*x / (5*(5 + 105*x^2 + 315*x^4 + 231*x^6))"

definition diff_delta_arctan_upper_34 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_34 \<equiv> \<lambda>x. -256 / ((5+105*x^2+315*x^4+231*x^6)^2*(1+x^2))"

lemma d_delta_arctan_upper_34:
  "((\<lambda>x. arctan_upper_34 x - arctan x) has_field_derivative diff_delta_arctan_upper_34 x) (at x)"
unfolding arctan_upper_34_def diff_delta_arctan_upper_34_def
apply (intro derivative_eq_intros | simp add: add_nonneg_eq_0_iff)+
apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
done

lemma d_delta_arctan_upper_34_pos: "diff_delta_arctan_upper_34 x < 0"
unfolding diff_delta_arctan_upper_34_def
apply (simp add: divide_simps add_nonneg_eq_0_iff zero_less_mult_iff)
using power2_less_0 [of x]
apply arith
done

lemma arctan_upper_34:
  assumes "x > 0"
    shows "arctan(x) < arctan_upper_34 x"
proof -
  have "((\<lambda>x. arctan_upper_34 x - arctan x) ---> pi / 2 - 0 - pi / 2) at_top"
    unfolding arctan_upper_34_def
    apply (intro tendsto_intros tendsto_arctan_at_top, auto)
    apply (rule tendsto_0_le [where f = inverse and K=1])
    apply (metis tendsto_inverse_0 at_top_le_at_infinity tendsto_mono)
    apply (simp add: eventually_at_top_linorder)
    apply (rule_tac x=1 in exI)
    apply (auto simp: divide_simps power_eq_if add_pos_pos algebra_simps)
    done
  then have *: "((\<lambda>x. arctan_upper_34 x - arctan x) ---> 0) at_top"
    by simp
  have "0 < arctan_upper_34 x - arctan x"
    apply (rule DERIV_neg_imp_decreasing_at_top [OF _ *])
    apply (metis d_delta_arctan_upper_34 d_delta_arctan_upper_34_pos)
    done
  then show ?thesis
    by auto
qed

section {*Lower Bound 3*}

definition arctan_lower_31 :: "real \<Rightarrow> real"
  where "arctan_lower_31 \<equiv> \<lambda>x. -(pi/2) - (33 + 170*x^2 + 165*x^4)*7*x / (5*(5 + 105*x^2 + 315*x^4 + 231*x^6))"

lemma arctan_lower_31:
  assumes "x < 0"
    shows "arctan(x) > arctan_lower_31 x"
    using arctan_upper_34 [of "-x"] assms
    by (auto simp: arctan_upper_34_def arctan_lower_31_def arctan_minus)

abbreviation "arctan_lower_32 \<equiv> arctan_upper_33"

lemma arctan_lower_32:
  assumes "x \<le> 0"
    shows "arctan(x) \<ge> arctan_lower_32 x"
    using arctan_upper_33 [of "-x"] assms
    by (auto simp: arctan_upper_33_def arctan_minus)

abbreviation "arctan_lower_33 \<equiv> arctan_upper_32"

lemma arctan_lower_33:
  assumes "x \<ge> 0"
    shows "arctan(x) \<ge> arctan_lower_33 x"
    using arctan_upper_32 [of "-x"] assms
    by (auto simp: arctan_upper_32_def arctan_minus)

definition arctan_lower_34 :: "real \<Rightarrow> real"
  where "arctan_lower_34 \<equiv> \<lambda>x. pi/2 - (64 + 735*x^2 + 945*x^4) / (15*x*(15 + 70*x^2 + 63*x^4))"

lemma arctan_lower_34:
  assumes "x > 0"
    shows "arctan(x) > arctan_lower_34 x"
    using arctan_upper_31 [of "-x"] assms
    by (auto simp: arctan_upper_31_def arctan_lower_34_def arctan_minus)

section {*Upper Bound 4*}

definition arctan_upper_41 :: "real \<Rightarrow> real"
  where "arctan_upper_41 \<equiv>
        \<lambda>x. -(pi/2) - (256 + 5943*x^2 + 19250*x^4 + 15015*x^6) /
               (35*x*(35 + 315*x^2 + 693*x^4 + 429*x^6))"

definition diff_delta_arctan_upper_41 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_41 \<equiv> \<lambda>x. 256 / (x^2*(35+315*x^2+693*x^4+429*x^6)^2*(1+x^2))"

lemma d_delta_arctan_upper_41:
  assumes "x \<noteq> 0"
    shows "((\<lambda>x. arctan_upper_41 x - arctan x) has_field_derivative diff_delta_arctan_upper_41 x) (at x)"
  unfolding arctan_upper_41_def diff_delta_arctan_upper_41_def
  using assms
  apply (intro derivative_eq_intros)
  apply (rule refl | simp add: add_nonneg_eq_0_iff)+
  apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
  done

lemma d_delta_arctan_upper_41_pos: "x \<noteq> 0 \<Longrightarrow> diff_delta_arctan_upper_41 x > 0"
unfolding diff_delta_arctan_upper_41_def
by (auto simp: zero_less_mult_iff add_pos_pos add_nonneg_eq_0_iff)

lemma arctan_upper_41:
  assumes "x < 0"
    shows "arctan(x) < arctan_upper_41 x"
proof -
  have *: "\<And>x::real. (35 + 315 * x\<^sup>2 + 693 * x ^ 4 + 429 * x ^ 6) > 0"
    by (sos "((R<1 + ((R<1 * ((R<13/8589934592 * [95/26*x^2 + 1]^2) + ((R<38654705675/4294967296 * [170080704731/154618822700*x^3 + x]^2) + ((R<14271/446676598784 * [x^2]^2) + (R<3631584276674589067439/2656331147370089676800 * [x^3]^2))))) + ((A<=0 * R<1) * (R<245426703/8589934592 * [1]^2)))))")
  then have **: "\<And>x::real. x < 0 \<Longrightarrow> \<not> (35 + 315 * x\<^sup>2 + 693 * x ^ 4 + 429 * x ^ 6) < 0"
    by (simp add: not_less)
  have "((\<lambda>x::real. (256 + 5943 * x\<^sup>2 + 19250 * x ^ 4 + 15015 * x ^ 6) /
           (35 * x * (35 + 315 * x\<^sup>2 + 693 * x ^ 4 + 429 * x ^ 6))) ---> 0) at_bot"
    apply (rule tendsto_0_le [where f = inverse and K=2])
    apply (metis at_bot_le_at_infinity tendsto_inverse_0 tendsto_mono)
    apply (simp add: eventually_at_bot_linorder)
    apply (rule_tac x="-1" in exI)
    apply (auto simp: ** abs_if divide_simps zero_less_mult_iff)
    done
  then have "((\<lambda>x. arctan_upper_41 x - arctan x) ---> - (pi / 2) - 0 - (- (pi / 2))) at_bot"
    unfolding arctan_upper_41_def
    apply (intro tendsto_intros tendsto_arctan_at_bot, auto)
    done
  then have *: "((\<lambda>x. arctan_upper_41 x - arctan x) ---> 0) at_bot"
    by simp
  have "0 < arctan_upper_41 x - arctan x"
    apply (rule DERIV_pos_imp_increasing_at_bot [OF _ *])
    apply (metis assms d_delta_arctan_upper_41 d_delta_arctan_upper_41_pos not_le)
    done
  then show ?thesis
    by auto
qed

definition arctan_upper_42 :: "real \<Rightarrow> real"
  where "arctan_upper_42 \<equiv>
          \<lambda>x. (15159*x^6+147455*x^4+345345*x^2+225225)*x / (35*(35*x^8+1260*x^6+6930*x^4+12012*x^2+6435))"

definition diff_delta_arctan_upper_42 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_42 \<equiv>
            \<lambda>x. -16384*x^16 / ((35*x^8+1260*x^6+6930*x^4+12012*x^2+6435)^2*(1+x^2))"

lemma d_delta_arctan_upper_42:
    "((\<lambda>x. arctan_upper_42 x - arctan x) has_field_derivative diff_delta_arctan_upper_42 x) (at x)"
    unfolding arctan_upper_42_def diff_delta_arctan_upper_42_def
    apply (intro derivative_eq_intros, simp_all)
    apply (auto simp: divide_simps add_nonneg_eq_0_iff, algebra)
    done

lemma arctan_upper_42:
  assumes "x \<le> 0" shows "arctan(x) \<le> arctan_upper_42 x"
apply (rule gen_upper_bound_decreasing [OF assms d_delta_arctan_upper_42])
apply (auto simp: diff_delta_arctan_upper_42_def arctan_upper_42_def)
done

definition arctan_upper_43 :: "real \<Rightarrow> real"
  where "arctan_upper_43 \<equiv>
          \<lambda>x. (256*x^6+5943*x^4+19250*x^2+15015)*x /
              (35 * (35*x^6+315*x^4+693*x^2+429))"

definition diff_delta_arctan_upper_43 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_43 \<equiv> \<lambda>x. 256*x^14 / ((35*x^6+315*x^4+693*x^2+429)^2*(1+x^2))"

lemma d_delta_arctan_upper_43:
    "((\<lambda>x. arctan_upper_43 x - arctan x) has_field_derivative diff_delta_arctan_upper_43 x) (at x)"
unfolding arctan_upper_43_def diff_delta_arctan_upper_43_def
apply (intro derivative_eq_intros, simp_all)
apply (auto simp: add_nonneg_eq_0_iff divide_simps, algebra)
done

lemma arctan_upper_43:
  assumes "x \<ge> 0" shows "arctan(x) \<le> arctan_upper_43 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_arctan_upper_43])
apply (auto simp: diff_delta_arctan_upper_43_def arctan_upper_43_def)
done

definition arctan_upper_44 :: "real \<Rightarrow> real"
  where "arctan_upper_44 \<equiv>
         \<lambda>x. pi/2 - (15159+147455*x^2+345345*x^4+225225*x^6)*x /
                 (35*(35+1260*x^2+6930*x^4+12012*x^6+6435*x^8))"

definition diff_delta_arctan_upper_44 :: "real \<Rightarrow> real"
  where "diff_delta_arctan_upper_44 \<equiv>
    \<lambda>x. -16384 / ((35+1260*x^2+6930*x^4+12012*x^6+6435*x^8)^2*(1+x^2))"

lemma d_delta_arctan_upper_44:
  "((\<lambda>x. arctan_upper_44 x - arctan x) has_field_derivative diff_delta_arctan_upper_44 x) (at x)"
unfolding arctan_upper_44_def diff_delta_arctan_upper_44_def
apply (intro derivative_eq_intros | simp add: add_nonneg_eq_0_iff)+
apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
done

lemma d_delta_arctan_upper_44_pos: "diff_delta_arctan_upper_44 x < 0"
unfolding diff_delta_arctan_upper_44_def
apply (auto simp: divide_simps add_nonneg_eq_0_iff zero_less_mult_iff)
using power2_less_0 [of x]
apply arith
done

lemma arctan_upper_44:
  assumes "x > 0"
    shows "arctan(x) < arctan_upper_44 x"
proof -
  have "((\<lambda>x. arctan_upper_44 x - arctan x) ---> pi / 2 - 0 - pi / 2) at_top"
    unfolding arctan_upper_44_def
    apply (intro tendsto_intros tendsto_arctan_at_top, auto)
    apply (rule tendsto_0_le [where f = inverse and K=1])
    apply (metis tendsto_inverse_0 at_top_le_at_infinity tendsto_mono)
    apply (simp add: eventually_at_top_linorder)
    apply (rule_tac x=1 in exI)
    apply (auto simp: zero_le_mult_iff divide_simps not_le[symmetric] power_eq_if algebra_simps)
    done
  then have *: "((\<lambda>x. arctan_upper_44 x - arctan x) ---> 0) at_top"
    by simp
  have "0 < arctan_upper_44 x - arctan x"
    apply (rule DERIV_neg_imp_decreasing_at_top [OF _ *])
    apply (metis d_delta_arctan_upper_44 d_delta_arctan_upper_44_pos)
    done
  then show ?thesis
    by auto
qed

section {*Lower Bound 4*}

definition arctan_lower_41 :: "real \<Rightarrow> real"
  where "arctan_lower_41 \<equiv>
     \<lambda>x. -(pi/2) - (15159+147455*x^2+345345*x^4+225225*x^6)*x /
                   (35*(35+1260*x^2+6930*x^4+12012*x^6+6435*x^8))"

lemma arctan_lower_41:
  assumes "x < 0"
    shows "arctan(x) > arctan_lower_41 x"
    using arctan_upper_44 [of "-x"] assms
    by (auto simp: arctan_upper_44_def arctan_lower_41_def arctan_minus)

abbreviation "arctan_lower_42 \<equiv> arctan_upper_43"

lemma arctan_lower_42:
  assumes "x \<le> 0"
    shows "arctan(x) \<ge> arctan_lower_42 x"
    using arctan_upper_43 [of "-x"] assms
    by (auto simp: arctan_upper_43_def arctan_minus)

abbreviation "arctan_lower_43 \<equiv> arctan_upper_42"

lemma arctan_lower_43:
  assumes "x \<ge> 0"
    shows "arctan(x) \<ge> arctan_lower_43 x"
    using arctan_upper_42 [of "-x"] assms
    by (auto simp: arctan_upper_42_def arctan_minus)

definition arctan_lower_44 :: "real \<Rightarrow> real"
  where "arctan_lower_44 \<equiv>
    \<lambda>x. pi/2 - (256+5943*x^2+19250*x^4+15015*x^6) /
               (35*x*(35+315*x^2+693*x^4+429*x^6))"

lemma arctan_lower_44:
  assumes "x > 0"
    shows "arctan(x) > arctan_lower_44 x"
    using arctan_upper_41 [of "-x"] assms
    by (auto simp: arctan_upper_41_def arctan_lower_44_def arctan_minus)

end


(*  Title:      HOL/Examples/Knaster_Tarski.thy
    Author:     Makarius

Typical textbook proof example.
*)

section \<open>Textbook-style reasoning: the Knaster-Tarski Theorem\<close>

theory Knaster_Tarski
  imports Main
begin

unbundle lattice_syntax

subsection \<open>Prose version\<close>

text \<open>
  According to the textbook @{cite \<open>pages 93--94\<close> "davey-priestley"}, the
  Knaster-Tarski fixpoint theorem is as follows.\<^footnote>\<open>We have dualized the
  argument, and tuned the notation a little bit.\<close>

  \<^bold>\<open>The Knaster-Tarski Fixpoint Theorem.\<close> Let \<open>L\<close> be a complete lattice and
  \<open>f: L \<rightarrow> L\<close> an order-preserving map. Then \<open>\<Sqinter>{x \<in> L | f(x) \<le> x}\<close> is a fixpoint
  of \<open>f\<close>.

  \<^bold>\<open>Proof.\<close> Let \<open>H = {x \<in> L | f(x) \<le> x}\<close> and \<open>a = \<Sqinter>H\<close>. For all \<open>x \<in> H\<close> we have
  \<open>a \<le> x\<close>, so \<open>f(a) \<le> f(x) \<le> x\<close>. Thus \<open>f(a)\<close> is a lower bound of \<open>H\<close>, whence
  \<open>f(a) \<le> a\<close>. We now use this inequality to prove the reverse one (!) and
  thereby complete the proof that \<open>a\<close> is a fixpoint. Since \<open>f\<close> is
  order-preserving, \<open>f(f(a)) \<le> f(a)\<close>. This says \<open>f(a) \<in> H\<close>, so \<open>a \<le> f(a)\<close>.\<close>

subsection \<open>Formal versions\<close>

text \<open>
  The Isar proof below closely follows the original presentation. Virtually
  all of the prose narration has been rephrased in terms of formal Isar
  language elements. Just as many textbook-style proofs, there is a strong
  bias towards forward proof, and several bends in the course of reasoning.
\<close>

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

text \<open>
  Above we have used several advanced Isar language elements, such as explicit
  block structure and weak assumptions. Thus we have mimicked the particular
  way of reasoning of the original text.

  In the subsequent version the order of reasoning is changed to achieve
  structured top-down decomposition of the problem at the outer level, while
  only the inner steps of reasoning are done in a forward manner. We are
  certainly more at ease here, requiring only the most basic features of the
  Isar language.
\<close>

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

end


(* Property from Productive Use of Failure in Inductive Proof,
   Andrew Ireland and Alan Bundy, JAR 1996.
   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.
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_prop_12
  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 rev :: "'a list => 'a list" where
  "rev (nil2) = nil2"
| "rev (cons2 z xs) = x (rev xs) (cons2 z (nil2))"

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

lemma app_assoc: "x (x y z) w = x y (x z w)" by (induction y, auto)
lemma qrev_rev: "qrev y z = x (rev y) z"
  apply(induction y arbitrary: z, auto)
  apply(simp add: app_assoc)
  done
lemma app_nil: "x y nil2 = y" by(induction y, auto)
lemma rev_app: "rev (x y z) = x (rev z) (rev y)"
  apply(induction y, auto)
   apply(simp add: app_nil)
  using app_assoc apply(auto)
  done

theorem property0 :
  "((qrev y z) = (x (rev y) z))"
  apply(induction y arbitrary: z, auto)
  apply(simp add: qrev_rev)
  apply(simp add: app_assoc)
  done

end