From Coq Require Import Ensembles.
From Coq Require Import List.
From Coq Require Import Arith.
From hydras.Ackermann Require Import folProp.
From hydras.Ackermann Require Import folProof.
From hydras.Ackermann Require Import folReplace.
From hydras.Ackermann Require Import folLogic3.
From hydras.Ackermann Require Import subProp.
From hydras.Ackermann Require Import ListExt.
From hydras.Ackermann Require Import NNtheory.
From hydras.Ackermann Require Import NN2PA.
From Goedel Require Import fixPoint.
From Goedel Require Import codeSysPrf.
From hydras.Ackermann Require Import PAtheory.
From hydras.Ackermann Require Import code.
From Goedel Require Import PRrepresentable.
From hydras.Ackermann Require Import expressible.
From hydras.Ackermann Require Import checkPrf.
From hydras.Ackermann Require Import codeNatToTerm.

Section Rosser's_Incompleteness.

Definition codeFormula := codeFormula LNT codeLNTFunction codeLNTRelation.

Variable T : System.
Definition T' : fol.System LNN :=
  Union _ NN
    (fun x : fol.Formula LNN => mem _ T (LNN2LNT_formula x)).

Lemma extendsNN : Included _ NN T'.
Proof.
unfold Included in |- *.
intros.
unfold T' in |- *.
left.
assumption.
Qed.

Hypothesis extendsPA : Included _ PA T.

Variable repT : Formula.
Variable v0 : nat.
Hypothesis
  freeVarRepT : forall v : nat, In v (freeVarFormula LNT repT) -> v = v0.
Hypothesis
  expressT1 :
    forall f : Formula,
    mem _ T f ->
    SysPrf T (substituteFormula LNT repT v0 (natToTerm (codeFormula f))).
Hypothesis
  expressT2 :
    forall f : Formula,
    ~ mem _ T f ->
    SysPrf T
      (notH (substituteFormula LNT repT v0 (natToTerm (codeFormula f)))).

Lemma freeVarRepT' :
 forall v : nat, In v (freeVarFormula LNN (LNT2LNN_formula repT)) -> v = v0.
Proof.
intros.
apply freeVarRepT.
rewrite <- (LNT2LNT_formula repT).
apply LNN2LNT_freeVarFormula2.
assumption.
Qed.

Lemma Tprf2T'prf :
 forall f : Formula, SysPrf T f -> folProof.SysPrf LNN T' (LNT2LNN_formula f).
Proof.
intros.
unfold T' in |- *.
apply
 (folLogic.sysExtend LNN)
  with
    (fun x : fol.Formula LNN =>
     mem (fol.Formula LNT) T (LNN2LNT_formula x)).
unfold Included in |- *.
intros.
right.
assumption.
induction H as (x, H); induction H as (x0, H).
exists (map LNT2LNN_formula x).
induction x0
 as
  [A|
   Axm1 Axm2 A B x0_1 Hrecx0_1 x0_0 Hrecx0_0|
   Axm A v n x0 Hrecx0|
   A B|
   A B C|
   A B|
   A v t|
   A v n|
   A B v|
   |
   |
   |
   R|
   f]; simpl in |- *.
exists (AXM LNN (LNT2LNN_formula A)).
intros.
unfold mem in |- *.
unfold Ensembles.In in |- *.
induction H0 as [H0| H0].
rewrite <- H0.
rewrite LNT2LNT_formula.
apply H.
auto with datatypes.
induction H0.
assert
 (forall g : fol.Formula LNT, In g Axm1 -> mem (fol.Formula LNT) T g).
auto with datatypes.
assert
 (forall g : fol.Formula LNT, In g Axm2 -> mem (fol.Formula LNT) T g).
auto with datatypes.
induction (Hrecx0_0 H1).
induction (Hrecx0_1 H0).
clear Hrecx0_0 Hrecx0_1 H0 H1.
assert
 (map LNT2LNN_formula (Axm1 ++ Axm2) =
  map LNT2LNN_formula Axm1 ++ map LNT2LNN_formula Axm2).
generalize Axm1 Axm2; intros.
induction Axm0 as [| a Axm0 HrecAxm0]; simpl in |- *.
reflexivity.
rewrite HrecAxm0.
reflexivity.
rewrite H0.
exists
 (MP LNN (map LNT2LNN_formula Axm1) (map LNT2LNN_formula Axm2)
    (LNT2LNN_formula A) (LNT2LNN_formula B) x0 x).
intros.
induction (in_app_or _ _ _ H1); auto.
induction (Hrecx0 H).
assert (~ In v (freeVarListFormula LNN (map LNT2LNN_formula Axm))).
clear x0 H Hrecx0 x H0.
unfold not in |- *; intros; apply n.
clear n.
induction Axm as [| a Axm HrecAxm].
auto.
simpl in |- *.
simpl in H.
apply in_or_app.
induction (in_app_or _ _ _ H).
left.
rewrite <- (LNT2LNT_formula a).
apply LNN2LNT_freeVarFormula2.
assumption.
auto.
exists (GEN LNN (map LNT2LNN_formula Axm) (LNT2LNN_formula A) v H1 x).
auto.
exists (IMP1 LNN (LNT2LNN_formula A) (LNT2LNN_formula B)).
tauto.
exists (IMP2 LNN (LNT2LNN_formula A) (LNT2LNN_formula B) (LNT2LNN_formula C)).
tauto.
exists (CP LNN (LNT2LNN_formula A) (LNT2LNN_formula B)).
tauto.
rewrite LNT2LNN_subFormula.
exists (FA1 LNN (LNT2LNN_formula A) v (LNT2LNN_term t)).
tauto.
rewrite <- LNT2LNN_freeVarFormula in n.
exists (FA2 LNN (LNT2LNN_formula A) v n).
tauto.
exists (FA3 LNN (LNT2LNN_formula A) (LNT2LNN_formula B) v).
tauto.
exists (EQ1 LNN).
tauto.
exists (EQ2 LNN).
tauto.
exists (EQ3 LNN).
tauto.
induction R.
induction f; simpl in |- *.
exists (EQ5 LNN Languages.Plus).
tauto.
exists (EQ5 LNN Languages.Times).
tauto.
exists (EQ5 LNN Languages.Succ).
tauto.
exists (EQ5 LNN Languages.Zero).
tauto.
Qed.

Lemma expressT'1 :
 forall f : Formula,
 mem _ T f ->
 folProof.SysPrf LNN T'
   (substituteFormula LNN (LNT2LNN_formula repT) v0
      (natToTermLNN (codeFormula f))).
Proof.
intros.
rewrite <- (LNT2LNN_natToTerm (codeFormula f)).
rewrite <- LNT2LNN_subFormula.
apply Tprf2T'prf.
apply expressT1.
assumption.
Qed.

Lemma expressT'2 :
 forall f : Formula,
 ~ mem _ T f ->
 folProof.SysPrf LNN T'
   (fol.notH LNN
      (substituteFormula LNN (LNT2LNN_formula repT) v0
         (natToTermLNN (codeFormula f)))).
Proof.
intros.
rewrite <- (LNT2LNN_natToTerm (codeFormula f)).
rewrite <- LNT2LNN_subFormula.
replace
 (fol.notH LNN
    (LNT2LNN_formula
       (substituteFormula LNT repT v0 (natToTerm (codeFormula f))))) with
 (LNT2LNN_formula
    (notH (substituteFormula LNT repT v0 (natToTerm (codeFormula f))))).
apply Tprf2T'prf.
apply expressT2.
assumption.
reflexivity.
Qed.

Definition codeSysPrf :=
  codeSysPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF codeArityLNTR
    codeArityLNTFIsPR codeArityLNTRIsPR (LNT2LNN_formula repT) v0.

Definition codeSysPrfCorrect1 :=
  codeSysPrfCorrect1 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNTRIsPR
    codeArityLNTRIsCorrect1 T' extendsNN T (LNT2LNN_formula repT) v0
    freeVarRepT' expressT'1.

Definition codeSysPrfCorrect2 :=
  codeSysPrfCorrect2 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNTRIsPR
    codeArityLNTRIsCorrect1 T' extendsNN T (LNT2LNN_formula repT) v0
    freeVarRepT' expressT'2.

Definition codeSysPrfCorrect3 :=
  codeSysPrfCorrect3 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNTRIsPR codeArityLNTRIsCorrect1
    codeArityLNTRIsCorrect2 codeLNTFunctionInj codeLNTRelationInj T'
    extendsNN.

Definition codePrf := codePrf LNT codeLNTFunction codeLNTRelation.

Definition codeSysPrfNot :=
  codeSysPrfNot LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTRIsPR
    (LNT2LNN_formula repT) v0.

Definition freeVarCodeSysPrfN :=
  freeVarCodeSysPrfN LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTRIsPR
    (LNT2LNN_formula repT) v0 freeVarRepT'.

Definition codeSysPrfNCorrect1 :=
  codeSysPrfNCorrect1 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNTRIsPR
    codeArityLNTRIsCorrect1 T' extendsNN T (LNT2LNN_formula repT) v0
    freeVarRepT' expressT'1.

Definition codeSysPrfNCorrect2 :=
  codeSysPrfNCorrect2 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNTRIsPR
    codeArityLNTRIsCorrect1 T' extendsNN T (LNT2LNN_formula repT) v0
    freeVarRepT' expressT'2.

Definition codeSysPrfNCorrect3 :=
  codeSysPrfNCorrect3 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNTRIsPR codeArityLNTRIsCorrect1
    codeArityLNTRIsCorrect2 codeLNTFunctionInj codeLNTRelationInj T'
    extendsNN (LNT2LNN_formula repT) v0 freeVarRepT'.

Lemma decideAxioms :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 forall x : Formulas,
 (forall g : Formula, In g x -> mem _ T g) \/
 (exists g : Formula, In g x /\ ~ mem _ T g).
Proof.
intros.
induction x as [| a x Hrecx].
left.
intros.
elim H0.
induction Hrecx as [H0| H0].
induction (H a).
left.
intros.
induction H2 as [H2| H2].
rewrite <- H2.
assumption.
auto.
right.
exists a.
split.
auto with datatypes.
assumption.
right.
induction H0 as (x0, H0).
exists x0.
induction H0 as (H0, H1).
auto with datatypes.
Qed.

Lemma searchProof :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 forall (a b : Formula) (A : Formulas) (p : Prf LNT A a),
 (exists B : Formulas,
    (exists q : Prf LNT B b,
       codePrf _ _ q < S (codePrf _ _ p) /\
       (forall x : Formula, In x B -> mem _ T x))) \/
 (forall (B : Formulas) (q : Prf LNT B b),
  codePrf _ _ q < S (codePrf _ _ p) ->
  exists g : Formula, In g B /\ ~ mem _ T g).
Proof.
intros.
induction (S (codePrf A a p)).
right.
intros.
elim (lt_n_O _ H0).
induction IHn as [H0| H0].
left.
decompose record H0.
exists x.
exists x0.
auto.
induction
 (eq_nat_dec
    (checkPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF codeArityLNTR
       (codeFormula b) n) 0).
right.
intros.
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H1)).
eauto.
rewrite <- H2 in a0.
rewrite
 (checkPrfCorrect1 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTRIsCorrect1)
  in a0.
discriminate a0.
decompose record
 (checkPrfCorrect2 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNTRIsCorrect1 codeArityLNTRIsCorrect2 codeLNTFunctionInj
    codeLNTRelationInj _ _ b0).
assert (x = b).
eapply codeFormulaInj.
apply codeLNTFunctionInj.
apply codeLNTRelationInj.
assumption.
rewrite <- H1.
induction (decideAxioms H x0).
left.
exists x0.
exists x1.
unfold codePrf in |- *.
rewrite H3.
auto.
right.
intros.
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H5)).
rewrite <- H1 in H0.
eauto.
assert (B = x0).
eapply (codePrfInjAxm LNT) with (p := q) (q := x1).
apply codeLNTFunctionInj.
apply codeLNTRelationInj.
transitivity n.
unfold codePrf in H6.
apply H6.
symmetry  in |- *.
apply H3.
rewrite H7.
assumption.
Qed.

Lemma T'prf2Tprf :
 forall f : fol.Formula LNN,
 folProof.SysPrf LNN T' f -> SysPrf T (LNN2LNT_formula f).
Proof.
assert
 (freeVarPA :
  forall x : Formulas,
  (forall g : fol.Formula LNT, In g x -> mem (fol.Formula LNT) PA g) ->
  forall v : nat, In v (freeVarListFormula LNT x) -> False).
intros.
induction x as [| a x Hrecx].
apply H0.
simpl in H0.
induction (in_app_or _ _ _ H0).
apply (closedPA v).
exists a.
auto with datatypes.
auto with datatypes.
intros.
induction H as (x, H); induction H as (x0, H).
unfold SysPrf, folProof.SysPrf in |- *.
assert
 (exists Axm : fol.Formulas LNT,
    (forall v : nat,
     In v (freeVarListFormula _ Axm) -> In v (freeVarListFormula _ x)) /\
    ex
      (fun _ : Prf LNT Axm (LNN2LNT_formula f) =>
       forall g : fol.Formula LNT,
       In g Axm -> mem (fol.Formula LNT) T g)).
induction x0
 as
  [A|
   Axm1 Axm2 A B x0_1 Hrecx0_1 x0_0 Hrecx0_0|
   Axm A v n x0 Hrecx0|
   A B|
   A B C|
   A B|
   A v t|
   A v n|
   A B v|
   |
   |
   |
   R|
   f]; simpl in |- *.
assert (mem (fol.Formula LNN) T' A).
auto with datatypes.
repeat induction H0.
exists (PA1 :: nil).
split.
auto.
exists (AXM _ PA1).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
exists (PA2 :: nil).
split.
auto.
exists (AXM _ PA2).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
exists (PA3 :: nil).
split.
auto.
exists (AXM _ PA3).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
exists (PA4 :: nil).
split.
auto.
exists (AXM _ PA4).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
exists (PA5 :: nil).
split.
auto.
exists (AXM _ PA5).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
exists (PA6 :: nil).
split.
auto.
exists (AXM _ PA6).
intros.
apply extendsPA.
induction H0 as [H0| H0].
rewrite <- H0.
repeat (right; constructor) || left.
elim H0.
assert (SysPrf PA (LNN2LNT_formula NN7)).
apply NN72PA.
induction H0 as (x, H0); induction H0 as (x0, H0).
exists x.
split.
intros.
apply (freeVarPA x H0 v H1).
exists x0.
intros.
apply extendsPA.
fold mem.
auto.
assert (SysPrf PA (LNN2LNT_formula NN8)).
apply NN82PA.
induction H0 as (x, H0); induction H0 as (x0, H0).
exists x.
split.
intros.
apply (freeVarPA x H0 v H1).
exists x0.
intros.
apply extendsPA.
fold mem.
auto.
assert (SysPrf PA (LNN2LNT_formula NN9)).
apply NN92PA.
induction H0 as (x, H0); induction H0 as (x0, H0).
exists x.
split.
intros.
apply (freeVarPA x H0 v H1).
exists x0.
intros.
apply extendsPA.
fold mem.
auto.
exists (LNN2LNT_formula x :: nil).
split.
simpl in |- *.
repeat rewrite <- app_nil_end.
apply (LNN2LNT_freeVarFormula1 x).
exists (AXM _ (LNN2LNT_formula x)).
intros.
induction H1 as [H1| H1].
unfold mem in H0.
unfold Ensembles.In in H0.
rewrite H1 in H0.
apply H0.
elim H1.
assert
 (forall g : fol.Formula LNN,
  In g Axm1 -> mem (fol.Formula LNN) T' g).
auto with datatypes.
assert
 (forall g : fol.Formula LNN,
  In g Axm2 -> mem (fol.Formula LNN) T' g).
auto with datatypes.
induction (Hrecx0_1 H0).
induction (Hrecx0_0 H1).
induction H2 as (H2, H4).
induction H3 as (H3, H5).
induction H4 as (x1, H4).
induction H5 as (x2, H5).
clear Hrecx0_1 H0 Hrecx0_0 H1.
exists (x ++ x0).
split.
repeat rewrite freeVarListFormulaApp.
intros.
induction (in_app_or _ _ _ H0); auto with datatypes.
simpl in x1.
exists (MP _ _ _ _ _ x1 x2).
intros.
induction (in_app_or _ _ _ H0); auto.
assert
 (forall g : fol.Formula LNN, In g Axm -> mem (fol.Formula LNN) T' g).
auto.
induction (Hrecx0 H0).
clear Hrecx0 H0.
induction H1 as (H0, H1).
induction H1 as (x1, H1).
exists x.
split.
assumption.
assert (~ In v (freeVarListFormula LNT x)).
auto.
exists (GEN _ _ _ _ H2 x1).
assumption.
exists (nil (A:=Formula)).
split.
auto.
exists (IMP1 _ (LNN2LNT_formula A) (LNN2LNT_formula B)).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (IMP2 _ (LNN2LNT_formula A) (LNN2LNT_formula B) (LNN2LNT_formula C)).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (CP _ (LNN2LNT_formula A) (LNN2LNT_formula B)).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
assert
 (SysPrf (Empty_set _)
    (impH (forallH v (LNN2LNT_formula A))
       (LNN2LNT_formula (substituteFormula LNN A v t)))).
apply
 impTrans with (substituteFormula LNT (LNN2LNT_formula A) v (LNN2LNT_term t)).
apply impI.
apply forallE.
apply Axm; right; constructor.
apply iffE2.
apply LNN2LNT_subFormula.
induction H0 as (x, H0).
induction H0 as (x0, H0).
induction x as [| a x Hrecx].
exists x0.
simpl in |- *; tauto.
assert (mem (fol.Formula LNT) (Empty_set (fol.Formula LNT)) a).
auto with datatypes.
induction H1.
exists (nil (A:=Formula)).
split.
auto.
assert (~ In v (freeVarFormula LNT (LNN2LNT_formula A))).
unfold not in |- *; intros; apply n.
apply LNN2LNT_freeVarFormula1.
assumption.
exists (FA2 _ (LNN2LNT_formula A) v H0).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (FA3 _ (LNN2LNT_formula A) (LNN2LNT_formula B) v).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (EQ1 LNT).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (EQ2 LNT).
simpl in |- *; tauto.
exists (nil (A:=Formula)).
split.
auto.
exists (EQ3 LNT).
simpl in |- *; tauto.
assert (SysPrf (Empty_set Formula) (LNN2LNT_formula (AxmEq4 LNN R))).
apply translateProof with (Empty_set (fol.Formula LNN)).
unfold ClosedSystem in |- *.
intros.
induction H0.
intros.
induction H0.
exists (nil (A:=fol.Formula LNN)).
exists (EQ4 LNN R).
simpl in |- *; tauto.
induction H0 as (x, H0).
induction H0 as (x0, H0).
exists x.
split.
intros.
induction (In_freeVarListFormulaE _ _ _ H1).
induction H2 as (H2, H3).
assert (mem (fol.Formula LNT) (Empty_set Formula) x1).
auto.
induction H4.
exists x0.
intros.
assert (mem (fol.Formula LNT) (Empty_set Formula) g).
auto.
induction H2.
assert (SysPrf (Empty_set Formula) (LNN2LNT_formula (AxmEq5 LNN f))).
apply translateProof with (Empty_set (fol.Formula LNN)).
unfold ClosedSystem in |- *.
intros.
induction H0.
intros.
induction H0.
exists (nil (A:=fol.Formula LNN)).
exists (EQ5 LNN f).
simpl in |- *; tauto.
induction H0 as (x, H0).
induction H0 as (x0, H0).
exists x.
split.
intros.
induction (In_freeVarListFormulaE _ _ _ H1).
induction H2 as (H2, H3).
assert (mem (fol.Formula LNT) (Empty_set Formula) x1).
auto.
induction H4.
exists x0.
intros.
assert (mem (fol.Formula LNT) (Empty_set Formula) g).
auto.
induction H2.
induction H0 as (x1, H0).
induction H0 as (H0, H1).
exists x1.
assumption.
Qed.

(*To prove the strong contructive result we need the decidability of T*)

Theorem Rosser'sIncompleteness :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 exists f : Formula,
   (forall v : nat, ~ In v (freeVarFormula LNT f)) /\
   (SysPrf T f \/ SysPrf T (notH f) -> Inconsistent LNT T).
Proof.
intros decide.
set
 (A :=
  fol.forallH LNN 1
    (fol.impH LNN codeSysPrf
       (fol.existH LNN 2
          (fol.andH LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1))
             (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))))))
 in *.
destruct (FixPointLNT (LNN2LNT_formula A) 0) as [x [H0 H1]].
exists x.
split.
unfold not in |- *; intros.
induction (H1 v).
assert
 (In v
    (list_remove nat eq_nat_dec 0 (freeVarFormula LNT (LNN2LNT_formula A)))).
apply H2.
assumption.
cut (In v (list_remove nat eq_nat_dec 0 (freeVarFormula LNN A))).
clear H4.
intros.
unfold A in H4.
SimplFreeVar.
assert (v <= 1).
apply
 (freeVarCodeSysPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTRIsPR
    (LNT2LNN_formula repT) v0 freeVarRepT').
apply H5.
destruct v as [| n].
apply H6.
reflexivity.
destruct n.
apply H7.
reflexivity.
apply (le_not_lt (S (S n)) 1).
assumption.
apply lt_n_S.
apply lt_O_Sn.
assert (v <= 1).
apply freeVarCodeSysPrfN.
assumption.
destruct v as [| n].
apply H6.
reflexivity.
destruct n.
apply H7.
reflexivity.
apply (le_not_lt (S (S n)) 1).
assumption.
apply lt_n_S.
apply lt_O_Sn.
eapply In_list_remove3.
apply LNN2LNT_freeVarFormula1.
eapply In_list_remove1.
apply H4.
eapply In_list_remove2.
apply H4.
intros.
induction H as [H| H].
unfold Inconsistent in |- *.
intros.
elim H.
intros.
induction H2 as (x1, H2).
induction (searchProof decide _ (notH x) _ x1).
decompose record H3.
apply contradiction with x.
assumption.
exists x2.
exists x3.
assumption.
apply
 contradiction
  with
    (existH 2
       (andH
          (LNN2LNT_formula
             (LNN.LT (fol.var LNN 2) (natToTermLNN (codePrf _ _ x1))))
          (substituteFormula LNT
             (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
                (natToTerm (codeFormula x))) 1 (var 2)))).
apply
 impE
  with
    (existH 2
       (andH
          (LNN2LNT_formula
             (LNN.LT (fol.var LNN 2) (natToTermLNN (codePrf x0 x x1))))
          (substituteFormula LNT
             (substituteFormula LNT
                (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
                   (natToTerm (codeFormula x))) 1 (var 2)) 1
             (natToTerm (codePrf _ _ x1))))).
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
apply (reduceExist LNT).
apply closedPA.
apply (reduceAnd LNT).
apply iffRefl.
apply (subFormulaNil LNT).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H4).
apply (In_list_remove2 _ _ _ _ _ H5).
reflexivity.
simpl in H5.
decompose sum H5.
discriminate H6.
replace (LNN.LT (fol.var LNN 2) (natToTermLNN (codePrf _ _ x1))) with
 (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 1
    (natToTermLNN (codePrf _ _ x1))).
apply
 impE
  with
    (existH 2
       (andH
          (substituteFormula LNT
             (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1))) 1
             (natToTerm (codePrf x0 x x1)))
          (substituteFormula LNT
             (substituteFormula LNT
                (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
                   (natToTerm (codeFormula x))) 1 (var 2)) 1
             (natToTerm (codePrf x0 x x1))))).
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
apply (reduceExist LNT).
apply closedPA.
apply (reduceAnd LNT).
apply iffSym.
rewrite <- LNN2LNT_natToTerm.
apply LNN2LNT_subFormula.
apply iffRefl.
rewrite <- (subFormulaAnd LNT).
apply
 impE
  with
    (existH 2
       (substituteFormula LNT
          (fol.andH LNT
             (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
             (substituteFormula LNT
                (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 1
                   (var 2)) 0 (natToTerm (codeFormula x)))) 1
          (natToTerm (codePrf x0 x x1)))).
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
apply (reduceExist LNT).
apply closedPA.
apply (reduceSub LNT).
apply closedPA.
apply (reduceAnd LNT).
apply iffRefl.
apply (subFormulaExch LNT).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
discriminate H5.
apply closedNatToTerm.
replace (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) with
 (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 0
    (natToTermLNN (codeFormula x))).
apply
 impE
  with
    (existH 2
       (substituteFormula LNT
          (fol.andH LNT
             (substituteFormula LNT
                (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1))) 0
                (natToTerm (codeFormula x)))
             (substituteFormula LNT
                (LNN2LNT_formula
                   (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))) 0
                (natToTerm (codeFormula x)))) 1 (natToTerm (codePrf x0 x x1)))).
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
apply (reduceExist LNT).
apply closedPA.
apply (reduceSub LNT).
apply closedPA.
apply (reduceAnd LNT).
apply iffSym.
rewrite <- LNN2LNT_natToTerm.
apply LNN2LNT_subFormula.
apply (reduceSub LNT).
apply closedPA.
replace (var 2) with (LNN2LNT_term (fol.var LNN 2)).
apply LNN2LNT_subFormula.
reflexivity.
rewrite <- (subFormulaAnd LNT).
replace
 (existH 2
    (substituteFormula LNT
       (substituteFormula LNT
          (fol.andH LNT
             (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
             (LNN2LNT_formula
                (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2)))) 0
          (natToTerm (codeFormula x))) 1 (natToTerm (codePrf x0 x x1)))) with
 (substituteFormula LNT
    (existH 2
       (substituteFormula LNT
          (fol.andH LNT
             (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
             (LNN2LNT_formula
                (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2)))) 0
          (natToTerm (codeFormula x)))) 1 (natToTerm (codePrf x0 x x1))).
replace
 (existH 2
    (substituteFormula LNT
       (fol.andH LNT (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
          (LNN2LNT_formula
             (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2)))) 0
       (natToTerm (codeFormula x)))) with
 (substituteFormula LNT
    (existH 2
       (fol.andH LNT (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
          (LNN2LNT_formula
             (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))))) 0
    (natToTerm (codeFormula x))).
apply
 impE
  with
    (substituteFormula LNT
       (substituteFormula LNT (LNN2LNT_formula codeSysPrf) 0
          (natToTerm (codeFormula x))) 1 (natToTerm (codePrf _ _ x1))).
repeat rewrite <- (subFormulaImp LNT).
apply forallE.
replace
 (forallH 1
    (substituteFormula LNT
       (fol.impH LNT (LNN2LNT_formula codeSysPrf)
          (existH 2
             (fol.andH LNT
                (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
                (LNN2LNT_formula
                   (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))))))
       0 (natToTerm (codeFormula x)))) with
 (substituteFormula LNT
    (forallH 1
       (fol.impH LNT (LNN2LNT_formula codeSysPrf)
          (existH 2
             (fol.andH LNT
                (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
                (LNN2LNT_formula
                   (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2)))))))
    0 (natToTerm (codeFormula x))).
apply impE with x.
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
apply H0.
assumption.
rewrite (subFormulaForall LNT).
induction (eq_nat_dec 1 0).
discriminate a.
induction (In_dec eq_nat_dec 1 (freeVarTerm LNT (natToTerm (codeFormula x)))).
elim (closedNatToTerm _ _ a).
reflexivity.
apply
 impE
  with
    (LNN2LNT_formula
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrf 0 (natToTermLNN (codeFormula x)))
          1 (natToTermLNN (codePrf x0 x x1)))).
apply iffE1.
apply sysExtend with PA.
apply extendsPA.
eapply iffTrans.
apply LNN2LNT_subFormula.
repeat rewrite <- LNN2LNT_natToTerm.
apply (reduceSub LNT).
apply closedPA.
apply LNN2LNT_subFormula.
apply T'prf2Tprf.
apply codeSysPrfCorrect1.
assumption.
rewrite (subFormulaExist LNT).
induction (eq_nat_dec 2 0).
discriminate a.
induction (In_dec eq_nat_dec 2 (freeVarTerm LNT (natToTerm (codeFormula x)))).
elim (closedNatToTerm _ _ a).
reflexivity.
rewrite (subFormulaExist LNT).
induction (eq_nat_dec 2 1).
discriminate a.
induction
 (In_dec eq_nat_dec 2 (freeVarTerm LNT (natToTerm (codePrf x0 x x1)))).
elim (closedNatToTerm _ _ a).
reflexivity.
unfold LNN.LT in |- *.
rewrite (subFormulaRelation LNN).
simpl in |- *.
reflexivity.
unfold LNN.LT in |- *.
rewrite (subFormulaRelation LNN).
simpl in |- *.
reflexivity.
apply nExist.
set
 (E :=
  LNN2LNT_formula
    (nat_rec (fun _ => fol.Formula LNN) (LNT2LNN_formula (equal Zero Zero))
       (fun (n : nat) rec =>
        fol.andH LNN
          (fol.notH LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrfNot 0
                   (natToTermLNN (codeFormula x))) 1
                (natToTermLNN n))) rec) (codePrf x0 x x1)))
 in *.
assert (forall x : nat, ~ In x (freeVarFormula LNT E)).
unfold E in |- *.
clear H3 E.
induction (codePrf x0 x x1).
simpl in |- *.
auto.
intros.
unfold nat_rec, nat_rect in |- *.
unfold not in |- *; intros.
set
 (Q :=
  (fix F (n : nat) : (fun _ : nat => fol.Formula LNN) n :=
     match n with
     | O => LNT2LNN_formula (equal Zero Zero)
     | S n0 =>
         (fun (n1 : nat) (rec : fol.Formula LNN) =>
          fol.andH LNN
            (fol.notH LNN
               (substituteFormula LNN
                  (substituteFormula LNN codeSysPrfNot 0
                     (natToTermLNN (codeFormula x))) 1
                  (natToTermLNN n1))) rec) n0 (F n0)
     end) n) in *.
assert
 (In x2
    (freeVarFormula LNN
       (fol.andH LNN
          (fol.notH LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrfNot 0
                   (natToTermLNN (codeFormula x))) 1
                (natToTermLNN n))) Q))).
apply LNN2LNT_freeVarFormula1.
assumption.
clear H3.
SimplFreeVar.
apply (le_not_lt x2 1).
apply freeVarCodeSysPrfN.
assumption.
destruct x2 as [| n0].
elim H6; reflexivity.
destruct n0.
elim H5; reflexivity.
apply lt_n_S.
apply lt_O_Sn.
rewrite <- LNT2LNN_natToTerm in H4.
rewrite LNT2LNN_freeVarTerm in H4.
apply (closedNatToTerm _ _ H4).
rewrite <- LNT2LNN_natToTerm in H4.
rewrite LNT2LNN_freeVarTerm in H4.
apply (closedNatToTerm _ _ H4).
apply (IHn x2).
apply LNN2LNT_freeVarFormula2.
assumption.
apply impE with E.
apply sysExtend with PA.
apply extendsPA.
apply impI.
apply forallI.
unfold not in |- *; intros.
induction H5 as (x2, H5).
induction H5 as (H5, H6).
induction H6 as [x2 H6| x2 H6].
apply (closedPA 2).
exists x2.
auto.
induction H6.
apply (H4 2).
assumption.
apply nAnd.
unfold orH, fol.orH in |- *.
apply
 impTrans
  with
    (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (natToTermLNN (codePrf x0 x x1)))).
apply impI.
apply nnE.
apply Axm; right; constructor.
apply impI.
apply impE with E.
apply
 impE
  with
    (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (natToTermLNN (codePrf x0 x x1)))).
do 2 apply sysWeaken.
apply PAboundedLT.
intros.
rewrite (subFormulaImp LNT).
rewrite (subFormulaNot LNT).
apply
 impE
  with
    (fol.impH LNT E
       (fol.notH LNT
          (substituteFormula LNT
             (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
                (natToTerm (codeFormula x))) 1 (natToTerm n)))).
apply iffE2.
apply (reduceImp LNT).
apply (subFormulaNil LNT).
apply H4.
apply (reduceNot LNT).
apply (subFormulaTrans LNT).
unfold not in |- *; intros.
SimplFreeVar.
apply (le_not_lt 2 1).
apply freeVarCodeSysPrfN.
apply LNN2LNT_freeVarFormula1.
apply H7.
apply lt_n_Sn.
unfold E in |- *.
clear E H4 H3.
apply impI.
induction (codePrf x0 x x1).
elim (lt_n_O _ H5).
unfold nat_rec, nat_rect in |- *.
set
 (Q :=
  (fix F (n1 : nat) : (fun _ : nat => fol.Formula LNN) n1 :=
     match n1 with
     | O => LNT2LNN_formula (equal Zero Zero)
     | S n2 =>
         (fun (n3 : nat) (rec : fol.Formula LNN) =>
          fol.andH LNN
            (fol.notH LNN
               (substituteFormula LNN
                  (substituteFormula LNN codeSysPrfNot 0
                     (natToTermLNN (codeFormula x))) 1
                  (natToTermLNN n3))) rec) n2 (F n2)
     end) n0) in *.
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H5)).
apply impE with (LNN2LNT_formula Q).
apply sysWeaken.
apply impI.
apply (IHn0 H3).
rewrite LNN2LNT_and.
eapply andE2.
apply Axm; right; constructor.
rewrite H3.
apply
 impE
  with
    (LNN2LNT_formula
       (fol.notH LNN
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrfNot 0
                (natToTermLNN (codeFormula x))) 1 (natToTermLNN n0)))).
apply sysWeaken.
apply iffE1.
apply
 iffTrans
  with
    (notH
       (LNN2LNT_formula
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrfNot 0
                (natToTermLNN (codeFormula x))) 1 (natToTermLNN n0)))).
apply iffRefl.
apply (reduceNot LNT).
rewrite <- LNN2LNT_natToTerm.
rewrite <- LNN2LNT_natToTerm.
apply
 iffTrans
  with
    (substituteFormula LNT
       (LNN2LNT_formula
          (substituteFormula LNN codeSysPrfNot 0
             (natToTermLNN (codeFormula x)))) 1
       (LNN2LNT_term (natToTermLNN n0))).
apply LNN2LNT_subFormula.
apply (reduceSub LNT).
apply closedPA.
apply LNN2LNT_subFormula.
eapply andE1.
rewrite LNN2LNT_and.
apply Axm; right; constructor.
apply Axm; right; constructor.
apply Axm; left; right; constructor.
unfold E in |- *.
clear H4 E.
induction (codePrf x0 x x1).
simpl in |- *.
apply eqRefl.
unfold nat_rec, nat_rect in |- *.
rewrite LNN2LNT_and.
apply andI.
induction
 (eq_nat_dec
    (checkPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF codeArityLNTR
       (codeFormula (notH x)) n) 0).
unfold codeSysPrfNot in |- *.
apply T'prf2Tprf.
apply codeSysPrfNCorrect3.
unfold not in |- *; intros.
rewrite H4 in a.
rewrite
 (checkPrfCorrect1 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTRIsCorrect1)
  in a.
discriminate a.
decompose record
 (checkPrfCorrect2 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNTRIsCorrect1 codeArityLNTRIsCorrect2 codeLNTFunctionInj
    codeLNTRelationInj _ _ b).
rewrite <- H6.
assert (x2 = notH x).
eapply codeFormulaInj.
apply codeLNTFunctionInj.
apply codeLNTRelationInj.
assumption.
cut (code.codePrf LNT codeLNTFunction codeLNTRelation x3 x2 x4 = n).
generalize x4.
clear H6 x4.
rewrite H4.
intros.
apply T'prf2Tprf.
apply codeSysPrfNCorrect2.
eapply H3.
apply lt_S.
rewrite <- H6.
apply lt_n_Sn.
assumption.
apply IHn.
intros.
eapply H3.
apply lt_S.
apply H4.
unfold Inconsistent in |- *.
intros.
elim H.
intros.
induction H2 as (x1, H2).
induction (searchProof decide _ x _ x1).
decompose record H3.
apply contradiction with x.
exists x2.
exists x3.
assumption.
assumption.
apply
 contradiction
  with
    (substituteFormula LNT (LNN2LNT_formula A) 0
       (natToTermLNT (code.codeFormula LNT codeLNTFunction codeLNTRelation x))).
unfold A in |- *.
replace
 (LNN2LNT_formula
    (fol.forallH LNN 1
       (fol.impH LNN codeSysPrf
          (fol.existH LNN 2
             (fol.andH LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1))
                (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2)))))))
 with
 (forallH 1
    (impH (LNN2LNT_formula codeSysPrf)
       (existH 2
          (andH (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
             (LNN2LNT_formula
                (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))))))).
rewrite (subFormulaForall LNT).
induction (eq_nat_dec 1 0).
discriminate a.
induction
 (In_dec eq_nat_dec 1
    (freeVarTerm LNT
       (natToTermLNT (code.codeFormula LNT codeLNTFunction codeLNTRelation x)))).
elim (closedNatToTerm _ _ a).
clear b0 b.
set
 (E :=
  LNN2LNT_formula
    (nat_rec (fun _ => fol.Formula LNN) (LNT2LNN_formula (equal Zero Zero))
       (fun (n : nat) rec =>
        fol.andH LNN
          (fol.notH LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrf 0
                   (natToTermLNN (codeFormula x))) 1
                (natToTermLNN n))) rec) (S (codePrf _ _ x1))))
 in *.
assert (forall x : nat, ~ In x (freeVarFormula LNT E)).
unfold E in |- *.
clear H3 E.
induction (S (codePrf x0 (notH x) x1)).
simpl in |- *.
auto.
intros.
unfold nat_rec, nat_rect in |- *.
unfold not in |- *; intros.
cut
 (In x2
    (freeVarFormula LNN
       (fol.andH LNN
          (fol.notH LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrf 0
                   (natToTermLNN (codeFormula x))) 1
                (natToTermLNN n)))
          ((fix F (n : nat) : (fun _ : nat => fol.Formula LNN) n :=
              match n with
              | O => LNT2LNN_formula (equal Zero Zero)
              | S n0 =>
                  (fun (n1 : nat) (rec : fol.Formula LNN) =>
                   fol.andH LNN
                     (fol.notH LNN
                        (substituteFormula LNN
                           (substituteFormula LNN codeSysPrf 0
                              (natToTermLNN (codeFormula x))) 1
                           (natToTermLNN n1))) rec) n0
                    (F n0)
              end) n)))).
clear H3.
intros.
SimplFreeVar.
apply (le_not_lt x2 1).
apply
 (freeVarCodeSysPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsPR codeArityLNTRIsPR
    (LNT2LNN_formula repT) v0 freeVarRepT').
apply H4.
destruct x2 as [| n0].
elim H6; reflexivity.
destruct n0.
elim H5; reflexivity.
apply lt_n_S.
apply lt_O_Sn.
rewrite <- LNT2LNN_natToTerm in H3.
rewrite LNT2LNN_freeVarTerm in H3.
apply (closedNatToTerm _ _ H3).
rewrite <- LNT2LNN_natToTerm in H3.
rewrite LNT2LNN_freeVarTerm in H3.
apply (closedNatToTerm _ _ H3).
assert
 (In x2
    (freeVarFormula LNT
       (LNN2LNT_formula
          (nat_rec (fun _ : nat => fol.Formula LNN)
             (LNT2LNN_formula (equal Zero Zero))
             (fun (n : nat) (rec : fol.Formula LNN) =>
              fol.andH LNN
                (fol.notH LNN
                   (substituteFormula LNN
                      (substituteFormula LNN codeSysPrf 0
                         (natToTermLNN (codeFormula x))) 1
                      (natToTermLNN n))) rec) n)))).
apply LNN2LNT_freeVarFormula2.
apply H3.
apply (IHn _ H4).
apply LNN2LNT_freeVarFormula1.
apply H3.
apply impE with E.
set
 (G :=
  substituteFormula LNT
    (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
       (natToTerm (codeFormula x))) 1 (natToTerm (codePrf x0 (notH x) x1)))
 in *.
apply impE with G.
apply sysExtend with PA.
assumption.
repeat apply impI.
apply forallI.
unfold not in |- *; intros.
induction H5 as (x2, H5); induction H5 as (H5, H6).
induction H6 as [x2 H6| x2 H6].
induction H6 as [x2 H6| x2 H6].
apply (closedPA 1).
exists x2.
auto.
induction H6.
unfold G in H5.
SimplFreeVar.
induction H6.
apply (H4 _ H5).
rewrite (subFormulaImp LNT).
rewrite (subFormulaExist LNT).
induction (eq_nat_dec 2 0).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNT
       (natToTermLNT (code.codeFormula LNT codeLNTFunction codeLNTRelation x)))).
elim (closedNatToTerm _ _ a).
clear b0 b.
rewrite (subFormulaAnd LNT).
apply
 impE
  with
    (fol.impH LNT
       (substituteFormula LNT (LNN2LNT_formula codeSysPrf) 0
          (natToTermLNT
             (code.codeFormula LNT codeLNTFunction codeLNTRelation x)))
       (fol.existH LNT 2
          (fol.andH LNT
             (LNN2LNT_formula (LNN.LT (fol.var LNN 2) (fol.var LNN 1)))
             (substituteFormula LNT
                (LNN2LNT_formula
                   (substituteFormula LNN codeSysPrfNot 1 (fol.var LNN 2))) 0
                (natToTermLNT
                   (code.codeFormula LNT codeLNTFunction codeLNTRelation x)))))).
repeat simple apply sysWeaken.
apply iffE1.
apply (reduceImp LNT).
apply iffRefl.
apply (reduceExist LNT).
apply closedPA.
apply (reduceAnd LNT).
apply
 iffTrans
  with
    (LNN2LNT_formula
       (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 0
          (natToTermLNN
             (code.codeFormula LNT codeLNTFunction codeLNTRelation x)))).
rewrite <- LNN2LNT_iff.
apply NN2PA.
apply (folLogic.iffRefl LNN).
rewrite <- LNN2LNT_natToTerm.
apply LNN2LNT_subFormula.
apply iffRefl.
apply
 orE
  with
    (LNN2LNT_formula
       (fol.orH LNN
          (LNN.LT (fol.var LNN 1) (natToTermLNN (codePrf x0 (notH x) x1)))
          (LNT2LNN_formula
             (equal (var 1) (natToTerm (codePrf x0 (notH x) x1))))))
    (LNN2LNT_formula
       (LNN.LT (natToTermLNN (codePrf x0 (notH x) x1)) (fol.var LNN 1))).
repeat simple apply sysWeaken.
apply
 impE
  with
    (LNN2LNT_formula
       (fol.orH LNN
          (LNN.LT (fol.var LNN 1) (natToTermLNN (codePrf x0 (notH x) x1)))
          (fol.orH LNN
             (LNT2LNN_formula
                (equal (var 1) (natToTerm (codePrf x0 (notH x) x1))))
             (LNN.LT (natToTermLNN (codePrf x0 (notH x) x1)) (fol.var LNN 1))))).
repeat rewrite LNN2LNT_or.
apply impI.
apply orSys.
apply orI1.
apply orI1.
apply Axm; right; constructor.
apply orSys.
apply orI1.
apply orI2.
apply Axm; right; constructor.
apply orI2.
apply Axm; right; constructor.
apply NN2PA.
simpl in |- *.
rewrite LNT2LNN_natToTerm.
apply nn9.
apply impI.
apply impE with G.
apply impE with E.
apply
 impE
  with
    (LNN2LNT_formula
       (LNN.LT (fol.var LNN 1) (natToTermLNN (S (codePrf x0 (notH x) x1))))).
repeat simple apply sysWeaken.
apply PAboundedLT.
intros.
repeat rewrite (subFormulaImp LNT).
repeat apply impI.
fold codeFormula in |- *.
apply
 contradiction
  with
    (substituteFormula LNT
       (substituteFormula LNT (LNN2LNT_formula codeSysPrf) 0
          (natToTermLNT (codeFormula x))) 1 (natToTerm n)).
apply Axm; right; constructor.
apply sysWeaken.
apply impE with E.
repeat simple apply sysWeaken.
apply impI.
clear H3 H4.
induction (S (codePrf x0 (notH x) x1)).
elim (lt_n_O _ H5).
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H5)).
unfold E in |- *.
apply
 impE
  with
    (LNN2LNT_formula
       (nat_rec (fun _ : nat => fol.Formula LNN)
          (LNT2LNN_formula (equal Zero Zero))
          (fun (n1 : nat) (rec : fol.Formula LNN) =>
           fol.andH LNN
             (fol.notH LNN
                (substituteFormula LNN
                   (substituteFormula LNN codeSysPrf 0
                      (natToTermLNN (codeFormula x))) 1
                   (natToTermLNN n1))) rec) n0)).
apply sysWeaken.
repeat apply impI.
apply IHn0.
assumption.
unfold nat_rec, nat_rect in |- *.
rewrite LNN2LNT_and.
eapply andE2.
apply Axm; right; constructor.
unfold E in |- *.
unfold nat_rec, nat_rect in |- *.
rewrite H3.
rewrite LNN2LNT_and.
apply
 impE
  with
    (LNN2LNT_formula
       (fol.notH LNN
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrf 0
                (natToTermLNN (codeFormula x))) 1 (natToTermLNN n0)))).
apply sysWeaken.
apply iffE1.
apply
 iffTrans
  with
    (notH
       (LNN2LNT_formula
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrf 0
                (natToTermLNN (codeFormula x))) 1 (natToTermLNN n0)))).
apply iffRefl.
apply (reduceNot LNT).
repeat rewrite <- LNN2LNT_natToTerm.
apply
 iffTrans
  with
    (substituteFormula LNT
       (LNN2LNT_formula
          (substituteFormula LNN codeSysPrf 0 (natToTermLNN (codeFormula x))))
       1 (LNN2LNT_term (natToTermLNN n0))).
apply LNN2LNT_subFormula.
apply (reduceSub LNT).
apply closedPA.
apply LNN2LNT_subFormula.
eapply andE1.
apply Axm; right; constructor.
apply impE with (substituteFormula LNT E 1 (natToTerm n)).
apply iffE1.
apply (subFormulaNil LNT).
apply H4.
apply Axm; left; right; constructor.
apply
 impE
  with
    (LNN2LNT_formula
       (fol.orH LNN
          (LNN.LT (fol.var LNN 1) (natToTermLNN (codePrf x0 (notH x) x1)))
          (LNT2LNN_formula
             (equal (var 1) (natToTerm (codePrf x0 (notH x) x1)))))).
repeat simple apply sysWeaken.
replace
 (impH
    (LNN2LNT_formula
       (fol.orH LNN
          (LNN.LT (fol.var LNN 1) (natToTermLNN (codePrf x0 (notH x) x1)))
          (LNT2LNN_formula
             (equal (var 1) (natToTerm (codePrf x0 (notH x) x1))))))
    (LNN2LNT_formula
       (LNN.LT (fol.var LNN 1) (natToTermLNN (S (codePrf x0 (notH x) x1))))))
 with
 (LNN2LNT_formula
    (fol.impH LNN
       (fol.orH LNN
          (LNN.LT (fol.var LNN 1) (natToTermLNN (codePrf x0 (notH x) x1)))
          (LNT2LNN_formula
             (equal (var 1) (natToTerm (codePrf x0 (notH x) x1)))))
       (LNN.LT (fol.var LNN 1) (natToTermLNN (S (codePrf x0 (notH x) x1)))))).
apply NN2PA.
simpl in |- *.
rewrite LNT2LNN_natToTerm.
apply nnPlusNotNeeded.
reflexivity.
apply Axm; right; constructor.
apply Axm; left; right; constructor.
apply Axm; do 2 left; right; constructor.
repeat apply impI.
apply sysWeaken.
apply existI with (natToTerm (codePrf x0 (notH x) x1)).
rewrite (subFormulaAnd LNT).
apply andI.
apply
 impE
  with
    (LNN2LNT_formula
       (LNN.LT (natToTermLNN (codePrf x0 (notH x) x1)) (fol.var LNN 1))).
repeat simple apply sysWeaken.
apply
 impTrans
  with
    (LNN2LNT_formula
       (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 2
          (natToTermLNN (codePrf x0 (notH x) x1)))).
replace
 (impH
    (LNN2LNT_formula
       (LNN.LT (natToTermLNN (codePrf x0 (notH x) x1)) (fol.var LNN 1)))
    (LNN2LNT_formula
       (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 2
          (natToTermLNN (codePrf x0 (notH x) x1))))) with
 (LNN2LNT_formula
    (fol.impH LNN
       (LNN.LT (natToTermLNN (codePrf x0 (notH x) x1)) (fol.var LNN 1))
       (substituteFormula LNN (LNN.LT (fol.var LNN 2) (fol.var LNN 1)) 2
          (natToTermLNN (codePrf x0 (notH x) x1))))).
apply NN2PA.
unfold LNN.LT in |- *.
apply (folLogic.impI LNN).
rewrite (subFormulaRelation LNN).
simpl in |- *.
apply (folLogic.Axm LNN); right; constructor.
reflexivity.
apply iffE1.
rewrite <- LNN2LNT_natToTerm.
apply LNN2LNT_subFormula.
apply Axm; right; constructor.
apply sysWeaken.
apply sysWeaken.
apply
 impE
  with
    (substituteFormula LNT
       (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
          (natToTerm (codeFormula x))) 1 (natToTerm (codePrf x0 (notH x) x1))).
apply sysWeaken.
apply iffE2.
fold codeFormula in |- *.
apply
 iffTrans
  with
    (substituteFormula LNT
       (substituteFormula LNT
          (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 1 (var 2)) 0
          (natToTermLNT (codeFormula x))) 2
       (natToTerm (codePrf x0 (notH x) x1))).
repeat (apply (reduceSub LNT); [ apply closedPA | idtac ]).
replace (var 2) with (LNN2LNT_term (fol.var LNN 2)).
apply LNN2LNT_subFormula.
reflexivity.
apply
 iffTrans
  with
    (substituteFormula LNT
       (substituteFormula LNT
          (substituteFormula LNT (LNN2LNT_formula codeSysPrfNot) 0
             (natToTermLNT (codeFormula x))) 1 (var 2)) 2
       (natToTerm (codePrf x0 (notH x) x1))).
repeat (apply (reduceSub LNT); [ apply closedPA | idtac ]).
apply (subFormulaExch LNT).
discriminate.
unfold not in |- *; intros; SimplFreeVar.
discriminate H6.
apply closedNatToTerm.
apply (subFormulaTrans LNT).
unfold not in |- *; intros; SimplFreeVar.
apply (le_not_lt 2 1).
apply freeVarCodeSysPrfN.
apply LNN2LNT_freeVarFormula1.
assumption.
apply lt_n_Sn.
apply Axm; right; constructor.
unfold G in |- *.
apply
 impE
  with
    (LNN2LNT_formula
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrfNot 0
             (natToTermLNN (codeFormula x))) 1
          (natToTermLNN (codePrf x0 (notH x) x1)))).
apply iffE1.
repeat rewrite <- LNN2LNT_natToTerm.
apply
 iffTrans
  with
    (substituteFormula LNT
       (LNN2LNT_formula
          (substituteFormula LNN codeSysPrfNot 0
             (natToTermLNN (codeFormula x)))) 1
       (LNN2LNT_term (natToTermLNN (codePrf x0 (notH x) x1)))).
apply LNN2LNT_subFormula.
apply sysExtend with PA.
assumption.
apply (reduceSub LNT).
apply closedPA.
apply LNN2LNT_subFormula.
apply T'prf2Tprf.
apply codeSysPrfNCorrect1.
assumption.
clear H4.
unfold E in |- *; clear E.
induction (S (codePrf x0 (notH x) x1)).
simpl in |- *.
apply eqRefl.
unfold nat_rec, nat_rect in |- *.
rewrite LNN2LNT_and.
apply andI.
induction
 (eq_nat_dec
    (checkPrf LNT codeLNTFunction codeLNTRelation codeArityLNTF codeArityLNTR
       (codeFormula x) n) 0).
unfold codeSysPrf, codeFormula in |- *.
apply T'prf2Tprf.
apply codeSysPrfCorrect3.
unfold not in |- *; intros.
rewrite H4 in a.
rewrite
 (checkPrfCorrect1 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTRIsCorrect1)
  in a.
discriminate a.
decompose record
 (checkPrfCorrect2 LNT codeLNTFunction codeLNTRelation codeArityLNTF
    codeArityLNTR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNTRIsCorrect1 codeArityLNTRIsCorrect2 codeLNTFunctionInj
    codeLNTRelationInj _ _ b).
rewrite <- H6.
assert (x2 = x).
eapply (codeFormulaInj LNT).
apply codeLNTFunctionInj.
apply codeLNTRelationInj.
assumption.
rewrite <- H4.
apply T'prf2Tprf.
apply codeSysPrfCorrect2.
rewrite <- H4 in H3.
apply H3 with x4.
rewrite <- H6.
apply lt_n_Sn.
apply IHn.
intros.
eapply H3.
apply lt_S.
apply H4.
reflexivity.
apply impE with (notH x).
apply cp2.
apply iffE2.
apply sysExtend with PA.
apply extendsPA.
assumption.
assumption.
Qed.

End Rosser's_Incompleteness.

From hydras.Ackermann Require Import codePA.
From hydras.Ackermann Require Import PAconsistent.

Theorem PAIncomplete :
 exists f : Formula,
   (Sentence f) /\ ~(SysPrf PA f \/ SysPrf PA (notH f)).
Proof.
assert
 (Expressible NN 1 codePA
    (substituteFormula LNN (primRecFormula 1 (proj1_sig codePAIsPR)) 0
       (natToTermLNN 1))).
apply (Representable2Expressible _ closedNN1).
simpl.
apply nn1.
apply primRecRepresentable.
induction H as (H, H0).
simpl in H0.
assert
 (exists f : Formula,
    (forall v : nat, ~ In v (freeVarFormula LNT f)) /\
    (SysPrf PA f \/ SysPrf PA (notH f) -> Inconsistent LNT PA)).
eapply
 Rosser'sIncompleteness
                        with
                        (repT :=
                          LNN2LNT_formula
                            (substituteFormula LNN
                               (primRecFormula 1 (proj1_sig codePAIsPR)) 0
                               (natToTermLNN 1)))
                       (v0 := 1).
unfold Included in |- *.
auto.
intros.
assert (v <= 1 /\ v <> 0).
apply H.
apply LNN2LNT_freeVarFormula1.
apply H1.
destruct v as [| n].
induction H2 as (H2, H3).
elim H3.
reflexivity.
destruct n.
reflexivity.
induction H2 as (H2, H3).
elim (le_not_lt _ _ H2).
apply lt_n_S.
apply lt_O_Sn.
intros.
rewrite <- LNN2LNT_natToTerm.
eapply impE.
apply iffE1.
apply LNN2LNT_subFormula.
apply NN2PA.
assert
 (if codePA (codeFormula f)
  then
   LNN.SysPrf NN
     (substituteFormula LNN
        (substituteFormula LNN (primRecFormula 1 (proj1_sig codePAIsPR)) 0
           (LNN.Succ LNN.Zero)) 1 (LNN.natToTerm (codeFormula f)))
  else
   LNN.SysPrf NN
     (LNN.notH
        (substituteFormula LNN
           (substituteFormula LNN (primRecFormula 1 (proj1_sig codePAIsPR)) 0
              (LNN.Succ LNN.Zero)) 1 (LNN.natToTerm (codeFormula f))))).
apply H0. clear H0.
assert (codePA (codeFormula f) = true).
apply codePAcorrect3.
assumption.
rewrite H0 in H2.
assumption.
intros.
rewrite <- LNN2LNT_natToTerm.
eapply
 impE
      with
      (LNN2LNT_formula
         (LNN.notH
            (substituteFormula LNN
               (substituteFormula LNN
                  (primRecFormula 1 (proj1_sig codePAIsPR)) 0
                  (LNN.Succ LNN.Zero)) 1 (LNN.natToTerm (codeFormula f))))).
simpl in |- *.
apply cp2.
apply iffE2.
apply LNN2LNT_subFormula.
apply NN2PA.
assert
 (if codePA (codeFormula f)
  then
   LNN.SysPrf NN
     (substituteFormula LNN
        (substituteFormula LNN (primRecFormula 1 (proj1_sig codePAIsPR)) 0
           (LNN.Succ LNN.Zero)) 1 (LNN.natToTerm (codeFormula f)))
  else
   LNN.SysPrf NN
     (LNN.notH
        (substituteFormula LNN
           (substituteFormula LNN (primRecFormula 1 (proj1_sig codePAIsPR)) 0
              (LNN.Succ LNN.Zero)) 1 (LNN.natToTerm (codeFormula f))))).
apply H0. clear H0.
assert (codePA (codeFormula f) = false).
apply codePAcorrect2.
assumption.
rewrite H0 in H2.
assumption.
apply PAdec.
clear H H0.
decompose record H1.
exists x.
split.
assumption.
unfold not in |- *; intros.
unfold Inconsistent in H2.
induction PAconsistent.
auto.
Qed.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable tT_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable tG_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable cong_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable deftogetherfour_1 : (forall A B C D E F G H : Universe, (exists X : Universe, (tT_ A B C D E F G H -> (betS_ E F X /\ (cong_ F X G H /\ tG_ A B C D E X))))).
Variable deftogetherfour2_2 : (forall A B C D E F G H X : Universe, ((betS_ E F X /\ (cong_ F X G H /\ tG_ A B C D E X)) -> tT_ A B C D E F G H)).
Variable lemma_TGsymmetric_3 : (forall A B C Xa Xb Xc : Universe, (tG_ A Xa B Xb C Xc -> tG_ B Xb A Xa C Xc)).

Theorem lemma_TTorder_4 : (forall A B C D E F G H : Universe, (tT_ A B C D E F G H -> tT_ C D A B E F G H)).
Proof.
  time tac.
Qed.

End FOFProblem.


Require Import Base.
Require Import Monad.
Require Import ClassicalMonads.
Require Import Nabla.
Require Import Kleene.
Require Import MultivalueMonad.
Require Import RealAxioms.
Require Import RealRing.
Require Import RealOrder.
Require Export RealOrderTactic.
Require Export RealLimit0.
Require Import RealLimit1.

Require Import Psatz.
Require Import PeanoNat.

Section RealMetric.
  Generalizable Variables K M Real.

  Context `{klb : LazyBool K} `{M_Monad : Monad M}
          {MultivalueMonad_description : Monoid_hom M_Monad NPset_Monad}
          {M_MultivalueMonad : MultivalueMonad}
          {Real : Type}
          {SemiDecOrderedField_Real : SemiDecOrderedField Real}
          {ComplArchiSemiDecOrderedField_Real : ComplArchiSemiDecOrderedField}.

  (* ring structure on Real *)
  Ltac IZReal_tac t :=
    match t with
    | real_0 => constr:(0%Z)
    | real_1 => constr:(1%Z)
    | IZreal ?u =>
      match isZcst u with
      | true => u
      | _ => constr:(InitialRing.NotConstant)
      end
    | _ => constr:(InitialRing.NotConstant)
    end.

  Add Ring realRing : (realTheory ) (constants [IZReal_tac]).

  Definition abs_prop : forall x : Real, {y : Real | (x > real_0 -> y = x) /\ (x = real_0 -> y = real_0) /\ (x < real_0 -> y = - x)}.
  Proof.
    intros x.

    apply real_mslimit_P_lt_p.
    destruct (real_total_order x real_0).
    exists (- x).
    split.
    repeat split.
    intro p; contradict p; auto with real.
    intro p; induction p; contradict H; auto with real.
    intros.
    destruct H0 as [_ [_ H0]].
    induction (H0 H); apply eq_refl.
    destruct H.
    exists real_0.
    repeat split; auto with real.
    intro p; induction H; contradict p; auto with real.
    intros.
    destruct H0 as [_ [H0 _]].
    induction (H0 H); apply eq_refl.
    exists x.
    repeat split; auto with real.
    intro p; contradict p; auto with real.
    intros.
    destruct H0 as [H0 [_ _]].
    induction (H0 H); apply eq_refl.

    intro.
    pose proof (M_split x real_0 (prec (n + 2))).
    assert (prec n > real_0);
      auto with real.

    assert (({x > real_0 - prec (n + 2)} + {real_0 > x - prec (n + 2)}) -> {e : Real | exists a : Real, ((x > real_0 -> a = x) /\ (x = real_0 -> a = real_0) /\ (x < real_0 -> a = - x)) /\ - prec n < e - a < prec n}).
    intro order.
    destruct order.
    exists x.
    destruct (real_total_order x real_0).
    exists (- x).
    repeat split; auto with real.
    intro j; contradict j; auto with real.
    intro j; induction j; contradict H0; auto with real.
    assert (x - - x =  x + x).
    ring.
    rewrite H1.
    replace (real_0 - prec (n + 2)) with ( - prec (n + 2)) in r by ring.
    assert (x + x > -prec (n + 2) + x).
    auto with real.

    pose proof (real_lt_plus_r_lt x _ _ r).
    exact H2.
    assert (- prec (n + 2) + x > - prec (n + 2) + - prec (n +2 )).
    apply (real_lt_plus_lt).
    exact r.
    assert (x + x > - prec (n + 2) + - prec (n + 2)).
    apply (real_lt_lt_lt _ _ _ H3 H2).
    assert (- prec n < - prec (n + 2) + - prec (n + 2)).
    apply real_lt_anti_anti.
    replace (  - (- prec (n + 2) + - prec (n + 2)))
      with (   prec (n + 2) + prec (n + 2)) by ring.
    replace (- - prec n) with (prec n) by ring.
    replace (n + 2)%nat with (n + 1 + 1)%nat by lia.
    rewrite prec_twice.
    apply prec_monotone; lia.
    apply (real_lt_lt_lt _ _ _ H5 H4).
    replace (x - - x) with (x + x) by ring.
    pose proof (real_lt_lt_plus_lt _ _ _ _ H0 H0).
    rewrite real_plus_unit in H1.
    pose proof (prec_pos n).
    apply (real_lt_lt_lt _ _ _ H1 H2).

    exists x.
    repeat split; auto; try intro; try ring.
    contradict H1.
    destruct H0.
    rewrite H0; auto with real.
    auto with real.

    apply real_lt_anti_anti.
    replace (- - prec n) with (prec n) by ring.
    replace (- (x - x)) with real_0 by ring.
    apply @prec_pos.
    replace ( (x - x)) with real_0 by ring.
    apply @prec_pos.

    exists (-x).
    destruct (real_total_order x real_0).
    exists (- x).
    repeat split; try intro; try auto with real; try ring.
    contradict H1; auto with real.
    rewrite H1; ring.
    apply real_lt_anti_anti.
    replace (-(- x - - x)) with real_0 by ring.
    replace (- - prec n) with (prec n) by ring.
    apply @prec_pos.
    replace (- x - - x) with real_0 by ring.
    apply @prec_pos.

    exists x.
    repeat split; try intro; try auto with real; try ring.
    contradict H1.
    destruct H0; auto with real.
    rewrite H0; auto with real.
    apply real_lt_anti_anti.
    replace (- (- x - x)) with (x + x) by ring.
    replace (- - prec n) with (prec n) by ring.
    apply (real_lt_plus_lt (prec (n + 2))) in r.
    apply (real_lt_lt_plus_lt _ _ _ _ r) in r.
    replace (prec (n + 2) + (x - prec (n + 2)) + (prec (n + 2) + (x - prec (n + 2)))) with
        (x + x) in r by ring.
    replace (prec (n + 2) + real_0 + (prec (n + 2) + real_0)) with (prec (n + 2) + prec (n + 2)) in r by ring.
    apply (real_lt_lt_lt _ _ _ r).
    replace (n + 2)%nat with (n + 1 + 1)%nat by lia.
    rewrite prec_twice.
    apply prec_monotone; lia.
    destruct H0.
    rewrite H0.
    replace (- real_0 - real_0) with real_0 by ring.
    apply @prec_pos.
    apply (real_lt_lt_plus_lt  _ _ _ _ H0) in H0.
    apply (real_lt_plus_lt (- x - x)) in H0.
    replace ( - x - x + (real_0 + real_0)) with (- x - x) in H0 by ring.
    replace (- x - x + (x + x)) with real_0 in H0 by ring.
    apply (real_lt_lt_lt _ _ _ H0).
    apply @prec_pos.

    apply (M_lift _ _  X0).
    apply M_split.
    apply @prec_pos.
  Defined.

  Definition abs : Real -> Real.
  Proof.
    intros x.
    destruct (abs_prop x).
    exact x0.
  Defined.

  Lemma abs_pos : forall x, real_0 <= abs x.
  Proof.
    intros.
    unfold abs.
    destruct (abs_prop x).
    destruct a as [a [b c]].
    destruct (real_total_order x real_0).
    pose proof (c H).
    rewrite H0.
    left.
    apply real_lt_anti_anti.
    replace (- - x) with x by ring.
    replace (- real_0) with real_0 by ring.
    exact H.
    destruct H.
    right.
    rewrite (b H); auto.

    left. rewrite( a H); auto.
  Qed.

  Definition dist : Real -> Real -> Real := fun x y => abs (x - y).

  Lemma dist_pos_t : forall x y, real_0 <= dist x y.
  Proof.
    intros.
    unfold dist.
    apply abs_pos.
  Qed.

  Local Hint Resolve abs_pos dist_pos_t: real.

  (* let us have a strong definition of dist then make other obligations derivable *)
  Lemma dist_prop : forall z1 z2 : Real,
      (z1 > z2 -> dist z1 z2 = z1 - z2)
      /\ (z1 = z2 -> dist z1 z2 = real_0)
      /\ (z1 < z2 -> dist z1 z2 = z2 - z1).
  Proof.
    intros.
    unfold dist.
    unfold abs.
    destruct ( abs_prop (z1 - z2)).
    repeat split.
    intro.
    destruct a as [a _].
    apply a.
    auto with real.
    intro.
    destruct a as [_ [a _]].
    apply a.
    induction H.
    ring.
    destruct a as [_ [_ a]].
    intro.
    replace (z2 -z1) with (- (z1 - z2)) by ring.
    apply a.
    pose proof (real_lt_plus_r_lt (-z2) _ _ H).
    replace (z1 - z2) with (z1 + - z2) by ring.
    replace real_0 with (z2 + - z2) by ring.
    exact H0.
  Qed.

  Local Hint Resolve dist_prop: real.

  (* Parameter dist : Real -> Real -> Real. *)
  (* Definition abs (z:real_) : Real := dist real_0 z. *)

  Lemma real_metric_inv : forall z1 z2 z3, dist z1 z2 = dist (z1 + z3) (z2 + z3).
  Proof.
    intros z1 z2 z3.
    unfold dist.
    replace (z1 + z3 - (z2 + z3)) with (z1 - z2) by ring.
    apply eq_refl.
  Qed.

  Lemma dist_pos : forall z1 z2 : Real, dist z1 z2 >= real_0.
  Proof.
    intros.
    destruct (dist_pos_t z1 z2).
    left; auto.
    right; auto.
  Qed.

  Lemma abs_symm : forall x, abs x = abs (-x).
  Proof.
    unfold abs.
    intro.
    destruct (abs_prop x).
    destruct (abs_prop (-x)).
    destruct (real_total_order x real_0).
    destruct a as [_ [_ a]].
    destruct a0 as [a0 _ ].
    rewrite (a H).
    apply (real_lt_anti) in H.
    replace (- real_0) with real_0 in H by ring.
    apply a0 in H.
    rewrite H.
    apply eq_refl.

    destruct H.
    destruct a as [_ [a _]].
    destruct a0 as [_ [a0 _]].
    rewrite H in a, a0.
    rewrite (a (eq_refl _)).
    assert ( -real_0 = real_0) by ring.
    rewrite (a0 H0).
    apply eq_refl.

    destruct a as [a [_ _]].
    destruct a0 as [_ [_ a0]].
    rewrite (a H).
    apply (real_lt_anti) in H.
    replace (- real_0) with real_0 in H by ring.

    rewrite (a0 H).
    ring.
  Qed.

  Lemma abs_zero : forall x, abs x = real_0 <-> x = real_0.
  Proof.
    intros.

    split.
    intro.
    unfold abs in H.
    destruct (abs_prop x).
    destruct (real_total_order x real_0).

    destruct a as [_ [_ a]].
    pose proof (a H0).
    rewrite H1 in H.
    apply (lp _ _ (fun x => - x)) in H.
    replace (- - x) with x in H by ring.
    replace (- real_0) with real_0 in H by ring.

    rewrite H in H0.
    contradict H0; auto with real.
    destruct H0.
    exact H0.
    destruct a as [a [_ _]].
    rewrite (a H0) in H.
    exact H.
    intro.
    unfold abs.
    destruct (abs_prop x).
    destruct a as [_ [a _ ]].
    auto.
  Qed.

  Lemma abs_tri : forall x y, (abs x) + abs y >= abs (x + y).
  Proof.
    intros.

    destruct (real_total_order x real_0).
    destruct (real_total_order y real_0).
    unfold abs.
    destruct (abs_prop x).
    destruct (abs_prop y).
    destruct (abs_prop (x + y)).
    pose proof (real_lt_lt_plus_lt _ _  _  _ H H0).
    rewrite real_plus_unit in H1.
    destruct a as [_ [_ a]].
    destruct a0 as [_ [_ a0]].
    destruct a1 as [_ [_ a1]].
    rewrite (a H).
    rewrite (a0 H0).
    rewrite (a1 H1).
    right.
    ring.
    destruct H0.
    rewrite H0.
    destruct (abs_zero real_0).
    rewrite (H2 (eq_refl _)).
    ring_simplify.
    replace (x + real_0) with x by ring.
    right; auto.

    unfold abs.
    destruct (abs_prop x).
    destruct (abs_prop y).
    destruct (abs_prop (x + y)).
    destruct a as [_ [_ a]].
    destruct a0 as [a0 [_ _]].
    rewrite (a H),  (a0 H0).

    destruct (real_total_order (x + y) real_0).
    destruct a1 as [_ [_ a1]]; rewrite (a1 H1).
    apply (real_ge_add_r (x + y)   (-x + y) (- (x + y))).
    replace (- x + y + (x + y)) with (y * (real_1 + real_1)) by ring.
    replace ( - (x + y) + (x + y)) with real_0 by ring.
    left.
    apply (real_lt_mult_r_pos_lt _ _ _ (real_2_pos )) in H0.
    replace (real_0 * real_2) with real_0 in H0 by ring.
    exact H0.

    destruct H1.
    destruct a1 as [_ [a1 _]]; rewrite (a1 H1).
    apply (real_ge_add_r x).
    ring_simplify.
    left.
    apply (real_lt_lt_lt _ _ _ H H0).

    destruct a1 as [a1 [_ _]]; rewrite (a1 H1).
    apply (real_ge_add_r (x-y)).
    replace (  - x + y + (x - y)) with real_0 by ring.
    replace (x + y + (x - y)) with (x + x) by ring.
    apply (real_lt_lt_plus_lt _ _ _ _ H) in H.
    left.
    replace (real_0 + real_0) with real_0 in H by ring.
    exact H.

    destruct H.
    rewrite H.
    destruct (abs_zero real_0).
    rewrite (H1 (eq_refl _)).
    ring_simplify.
    replace (real_0 + y) with y by ring.
    right; auto.

    destruct (real_total_order y real_0).
    unfold abs.
    destruct (abs_prop x).
    destruct (abs_prop y).
    destruct (abs_prop (x + y)).
    destruct a as [a [_ _]].
    destruct a0 as [_ [_ a0]].
    rewrite (a H),  (a0 H0).

    destruct (real_total_order (x + y) real_0).
    destruct a1 as [_ [_ a1]]; rewrite (a1 H1).
    apply (real_ge_add_r (x + y)).
    replace (- (x + y) + (x + y)) with real_0 by ring.
    replace (x + - y + (x + y)) with (x * (real_1 + real_1)) by ring.
    left.
    apply (real_lt_mult_r_pos_lt  _ _ _ (real_2_pos)) in H.
    replace (real_0 * real_2) with real_0 in H by ring.
    exact H.

    destruct H1.
    destruct a1 as [_ [a1 _]]; rewrite (a1 H1).
    rewrite<- H1.
    apply (real_ge_add_r ( y - x)).
    replace ( x + - y + (y - x)) with real_0 by ring.
    replace (x + y + (y - x)) with (y + y) by ring.
    apply (real_lt_lt_plus_lt _ _ _ _ H0) in H0.
    replace (real_0 + real_0) with real_0 in H0 by ring.
    left; exact H0.

    destruct a1 as [a1 [_ _]]; rewrite (a1 H1).
    apply (real_ge_add_r ( y - x)).
    replace (x + - y + (y - x)) with real_0 by ring.
    replace (x + y + (y - x)) with (y + y) by ring.
    apply (real_lt_lt_plus_lt _ _ _ _ H0) in H0.
    replace (real_0 + real_0) with real_0 in H0 by ring.
    left; exact H0.

    destruct H0.
    rewrite H0.
    destruct (abs_zero real_0).
    rewrite (H2 (eq_refl _)).
    ring_simplify.
    replace (x + real_0) with x by ring.
    right; auto.

    unfold abs.
    destruct (abs_prop x) , (abs_prop y), (abs_prop (x + y)).
    destruct a as [a [_ _]].
    destruct a0 as [a0 [_ _]].
    rewrite (a H),  (a0 H0).

    pose proof (real_lt_lt_plus_lt _ _ _ _ H H0).
    rewrite real_plus_unit in H1.
    destruct a1 as [a1 _].
    rewrite (a1 H1).
    right; auto.
  Qed.

  Lemma dist_symm : forall z1 z2 : Real, dist z1 z2 = dist z2 z1.
  Proof.
    intros; unfold dist.
    rewrite (abs_symm (z1 - z2)).
    replace (-(z1 - z2)) with (z2 - z1) by ring.
    apply eq_refl.
  Qed.

  Lemma dist_tri : forall z1 z2 z3, (dist z1 z2) + (dist z2 z3) >= dist z1 z3.
  Proof.
    intros.
    unfold dist.
    pose proof (abs_tri (z1 - z2) (z2 - z3)).
    replace (z1 - z3) with (z1 - z2 + (z2 - z3)) by ring.
    exact H.
  Qed.

  Lemma dist_zero : forall z1 z2 : Real, dist z1 z2 = real_0 <-> z1 = z2.
  Proof.
    intros.
    unfold dist.
    pose proof (abs_zero (z1 - z2)).
    split.
    destruct H.
    intro.
    pose proof (H H1).
    apply (lp _ _ (fun x => x + z2)) in H2.
    ring_simplify in H2.
    exact H2.
    intro.
    destruct H.
    apply (lp _ _ (fun x => x - z2)) in H0.
    replace (z2 - z2) with real_0 in H0 by ring.
    exact (H1 H0).
  Qed.

  Local Hint Resolve  dist_pos dist_symm dist_tri dist_zero: real.

  Lemma real_metric_sand : forall z1 z2 z3, z1-z3<=z2<=z1+z3 -> dist z1 z2 <= z3.
  Proof.
    intros z1 z2 z3 p.

    (* ddd *)
    destruct p as [p1 p2].
    destruct (dist_prop z1 z2) as [q1 [q2 q3]];
      destruct (real_total_order z1 z2) as [r1 | [r2 | r3]].
    rewrite (q3 r1).
    destruct p2.
    apply (real_lt_plus_lt (-z1) z2 (z1+z3)) in H.
    ring_simplify in H.
    replace (-z1+z2) with (z2-z1) in H by ring; left; exact H.
    rewrite H.
    ring_simplify; right; exact eq_refl.

    rewrite (q2 r2); rewrite r2 in p2.
    destruct p2.
    apply (real_lt_plus_lt (-z2) z2 (z2+z3)) in H.
    replace (- z2 + z2) with real_0 in H by ring.
    replace (- z2 + (z2 + z3)) with z3 in H by ring.
    left; exact H.
    apply (real_eq_plus_eq z2 (z2+z3) (-z2)) in H.
    replace (z2 +- z2) with real_0 in H by ring.
    replace (z2 + z3 + - z2) with z3 in H by ring.
    right; exact H.

    rewrite (q1 r3).
    apply (real_le_plus_le (-z2 + z3)) in p1.
    replace (- z2 + z3 + z2) with z3 in p1 by ring.
    replace (-z2 + z3 + (z1 - z3)) with (z1 - z2) in p1 by ring.
    exact p1.
  Qed.
  Local Hint Resolve real_metric_sand: real.

  Lemma real_metric_plus_inv : forall z1 z2 z3, dist z1 z2 = dist (z3 + z1) (z3 + z2).
  Proof.
    intros z1 z2 z3;
      replace (z3+z1) with (z1+z3) by ring;
      replace (z3+z2) with (z2+z3) by ring; exact (real_metric_inv z1 z2 z3).
  Qed.
  Local Hint Resolve real_metric_plus_inv: real.

  Lemma real_metric_or : forall z1 z2, dist z1 z2 = z1 - z2 \/ dist z1 z2 = z2 - z1.
  Proof.
    intros z1 z2.
    destruct (real_total_order z1 z2) as [r1 | [r2 | r3]];
      destruct (dist_prop z1 z2) as [l1 [l2 l3]].
    right; rewrite (l3 r1); exact eq_refl.
    rewrite r2 at 2.
    replace (z2 - z2) with real_0 by ring.
    left.
    exact (l2 r2).
    left; rewrite (l1 r3); exact eq_refl.
  Qed.
  Local Hint Resolve real_metric_or: real.

  Lemma real_metric_Or : forall z1 z2, (dist z1 z2 = z1-z2 /\ z1 >= z2) \/
                                       (dist z1 z2 = z2-z1 /\ z2 >= z1).
  Proof.
    intros z1 z2.
    destruct (real_total_order z1 z2) as [r1 | [r2 | r3]];
      destruct (dist_prop z1 z2) as [l1 [l2 l3]].
    right; rewrite (l3 r1); exact (conj eq_refl (real_gt_ge z2 z1 r1)).
    rewrite r2 at 2.
    left; split.
    replace (z2 - z2) with real_0 by ring.
    exact (l2 r2).
    right; exact r2.
    left; rewrite (l1 r3); exact (conj eq_refl (real_gt_ge  z1 z2 r3)).
  Qed.
  Local Hint Resolve real_metric_Or: real.

  Lemma real_metric_gtgt_sand : forall z1 z2 z3, z3> real_0 -> z1-z3<z2<z1+z3 -> dist z1 z2 < z3.
  Proof.
    intros z1 z2 z3 q p.
    destruct p as [p1 p2].
    destruct (real_metric_Or z1 z2) as [[a b] | [a b]]; rewrite a.
    apply (real_lt_plus_lt (z3-z2) (z1-z3) z2) in p1.
    ring_simplify in p1.
    replace (-z2+z1) with (z1-z2) in p1 by ring.
    exact p1.
    apply (real_lt_plus_lt (-z1) z2 (z1+z3)) in p2.
    ring_simplify in p2.
    replace (-z1+z2) with (z2-z1) in p2 by ring.
    exact p2.
  Qed.
  Local Hint Resolve real_metric_gtgt_sand: real.

  Lemma real_metric_minus_inv : forall z1 z2 z3, dist z1 z2 = dist (z1 - z3) (z2 - z3).
  Proof.
    intros z1 z2 z3;
      pose proof (real_metric_inv z1 (z2) (-z3)) as H;
      replace (z1-z3) with (z1+-z3) by ring;
      replace (z2-z3) with (z2+-z3) by ring; exact H.
  Qed.
  Local Hint Resolve real_metric_minus_inv: real.

  Lemma lt_metric : forall x y, x < y -> dist x y = y - x.
  Proof.
    intros x y p.
    destruct (real_metric_Or x y) as [[P Q] | [P Q]].
    contradict Q; auto with real.
    exact P.
  Qed.
  Local Hint Resolve lt_metric: real.

  Lemma le_metric : forall x y, x <= y -> dist x y = y - x.
  Proof.
    intros x y p.
    destruct p.
    apply lt_metric; exact H.
    rewrite H.
    replace (y - y) with real_0 by ring.
    rewrite (dist_zero y y); exact eq_refl.
  Qed.

  Lemma dist_0_1 : dist real_0 real_1 = real_1.
  Proof.
    rewrite (lt_metric real_0 real_1 real_1_gt_0).
    ring.
  Qed.

  Lemma dist_1_0 : dist real_1 real_0 = real_1.
  Proof.
    rewrite (dist_symm real_1 real_0).
    exact dist_0_1.
  Qed.

  Definition convex (x y w1 w2 : Real) : x < y -> w1 > real_0 -> w2 > real_0 -> Real.
  Proof.
    intros p p1 p2.
    pose proof (real_lt_lt_plus_lt real_0 w1 real_0 w2 p1 p2).
    rewrite real_plus_unit in H.
    exact ((x*w1+y*w2)/(real_gt_neq (w1+w2) real_0 H)).
  Defined.

  Local Hint Resolve lt_metric: real.
  Local Hint Resolve le_metric: real.
  Local Hint Resolve dist_0_1: real.
  Local Hint Resolve dist_1_0: real.

  Lemma convexity : forall x y w1 w2,
      forall (p:x < y) (q:w1 > real_0) (r:w2 > real_0),
        x < convex x y w1 w2 p q r < y.
  Proof.
    intros.
    split.
    + unfold convex.
      apply (real_lt_mult_r_pos_lt x y w2 r) in p.
      apply (real_lt_plus_lt  (w1*x) (x*w2) (y*w2)) in p.
      assert (w1+w2 <> real_0) as Path.
      apply real_gt_neq.
      replace real_0 with (real_0 + real_0) by ring.
      apply real_lt_lt_plus_lt; auto.
      rewrite <- (irrl  _ Path (real_gt_neq (w1 + w2) real_0
                                            (eq_ind (real_0 + real_0) (fun t : Real => t < w1 + w2) (real_lt_lt_plus_lt real_0 w1 real_0 w2 q r) real_0
                                                    (real_plus_unit real_0)))).

      apply (real_lt_plus_lt  w2 real_0 w1) in q.
      replace (w2+real_0) with w2 in q by ring.
      replace (w2+w1) with (w1+w2) in q by ring.
      pose proof (real_lt_lt_lt real_0 w2 (w1+w2) r q).
      replace (w1 * x + x * w2) with (x*(w1  + w2)) in p by ring.
      assert (/Path > real_0).
      apply real_pos_inv_pos.
      apply H.
      apply (real_lt_mult_r_pos_lt (x*(w1+w2)) (w1*x+y*w2) (/Path) H0) in p.
      rewrite real_mult_assoc, (real_mult_comm (w1+w2) (/Path)) in p.
      rewrite (real_mult_inv (w1 + w2) Path), real_mult_comm, real_mult_unit in p.
      replace (w1*x) with (x*w1) in p by ring.
      exact p.

    + unfold convex.
      apply (real_lt_mult_r_pos_lt x y w1 q) in p.
      apply (real_lt_plus_lt  (w2*y) (x*w1) (y*w1)) in p.
      assert (w1+w2 <> real_0) as Path.
      apply real_gt_neq.
      replace real_0 with (real_0 + real_0) by ring.
      apply real_lt_lt_plus_lt; auto.
      rewrite <- (irrl _ Path (real_gt_neq (w1 + w2) real_0
                                           (eq_ind (real_0 + real_0) (fun t : Real => t < w1 + w2) (real_lt_lt_plus_lt real_0 w1 real_0 w2 q r) real_0
                                                   (real_plus_unit real_0)))).

      apply (real_lt_plus_lt  w1 real_0 w2) in r.
      replace (w1+real_0) with w1 in r by ring.
      pose proof (real_lt_lt_lt real_0 w1 (w1+w2) q r).
      replace (w2 * y + y * w1) with (y * (w1  + w2)) in p by ring.
      assert (/Path > real_0).
      apply real_pos_inv_pos.
      apply H.
      apply (real_lt_mult_r_pos_lt (w2*y+x*w1) (y*(w1+w2)) (/Path) H0) in p.
      rewrite real_mult_assoc in p at 1.
      replace ((w1 + w2) * / Path) with (/Path*(w1+w2)) in p by auto with real.
      rewrite (real_mult_inv (w1 + w2) Path) in p.
      replace (y*real_1) with y in p by ring.
      replace  (w2 * y + x * w1) with (x * w1 + y * w2) in p by ring.
      exact p.
  Qed.

  Lemma dist_le_prop : forall a b c, dist a b <= c <-> - c <= a - b <= c.
  Proof.
    intros.
    split.
    intros.
    destruct (dist_prop a b).
    destruct H1.
    destruct (real_total_order a b).
    rewrite (H2 H3) in H.
    split; auto.
    apply (real_le_plus_le (a - b - c)) in H; ring_simplify in H; auto.
    apply (fun a => real_le_le_le _ _ _ a H).
    pose proof (real_lt_plus_lt (-a) _ _ H3).
    pose proof (real_lt_plus_lt (-b) _ _ H3).
    replace (-a + a) with real_0 in H4 by ring.
    replace (-b + b) with real_0 in H5 by ring.
    pose proof (real_lt_lt_lt _ _ _ H5 H4).
    replace (a - b) with (-b + a) by ring; replace (b - a) with (- a + b) by ring; left; auto.
    destruct H3.
    induction H3.
    rewrite (H1 (eq_refl)) in H.
    split.
    replace (a - a) with real_0 by ring.
    apply (real_le_plus_le (-c )) in H.
    replace (- c + c) with real_0 in H by ring.
    replace (- c + real_0) with (-c) in H by ring.
    auto.
    replace (a - a) with real_0 by ring.
    auto.
    rewrite (H0 H3) in H.
    split; auto.
    apply (real_lt_plus_lt (- b)) in H3.
    replace (-b + b) with real_0 in H3 by ring.

    replace (-b + a) with (a - b) in H3 by ring.
    destruct H.
    pose proof (real_lt_lt_lt _ _ _ H3 H).
    apply (real_lt_plus_lt (-c)) in H4.
    replace (- c + real_0) with (-c) in H4 by ring.
    replace (-c + c) with real_0 in H4 by ring.
    left; apply (real_lt_lt_lt  _ _ _ H4 H3).
    rewrite H.
    rewrite H in H3.
    pose proof (real_lt_lt_plus_lt _ _ _ _ H3 H3).
    apply (real_lt_plus_lt (-c)) in H4.
    ring_simplify in H4.
    left; auto.
    intro.
    pose proof (dist_prop a b).
    destruct H0.
    destruct H1.
    destruct (real_total_order a b).
    rewrite (H2 H3).
    destruct H.
    apply (real_le_plus_le (c + b - a)) in H.
    ring_simplify in H.
    exact H.
    destruct H3.
    induction H3.
    rewrite (H1 eq_refl).
    destruct H.
    replace (a - a) with real_0 in H3 by ring.
    exact H3.
    destruct H.
    rewrite (H0 H3).
    exact H4.
  Defined.

  Lemma real_lt_pos_mult_neg_neg : forall z1 z2 : Real, z1 > real_0 -> z2 < real_0 -> z1 * z2 < real_0.
  Proof.
    intros.
    apply (real_lt_mult_pos_lt _ _ _  H) in  H0.
    replace (z1 * real_0) with real_0 in H0 by ring.
    auto.
  Qed.

  Lemma real_lt_neg_mult_pos_neg : forall z1 z2 : Real, z1 < real_0 -> z2 > real_0 -> z1 * z2 < real_0.
  Proof.
    intros.
    apply (real_lt_mult_pos_lt _ _ _  H0) in  H.
    replace (z2 * real_0) with real_0 in H by ring.
    rewrite real_mult_comm in H.
    auto.
  Qed.

  Lemma real_lt_neg_mult_neg_pos : forall z1 z2 : Real, z1 < real_0 -> z2 < real_0 -> z1 * z2 > real_0.
  Proof.
    intros.
    apply (real_lt_plus_lt (-z1)) in H.
    apply (real_lt_plus_lt (-z2)) in H0.
    replace (- z2 + z2) with real_0 in H0 by ring.
    replace (- z1 + z1) with real_0 in H by ring.
    rewrite real_plus_comm, real_plus_unit in H.
    rewrite real_plus_comm, real_plus_unit in H0.
    apply (real_lt_mult_pos_lt _ _ _  H0) in  H.
    replace (- z2 *real_0) with real_0 in H by ring.
    replace (-z2*-z1) with (z1 * z2) in H by ring.
    auto.
  Qed.

  Lemma abs_mult : forall x y : Real, abs (x * y) = (abs x) * (abs y).
  Proof.
    intros.
    unfold abs.
    destruct (abs_prop (x * y)).
    destruct (abs_prop (x)).
    destruct (abs_prop (y)).
    destruct (real_total_order x real_0).
    destruct (real_total_order y real_0).
    assert (x * y > real_0).
    apply real_lt_neg_mult_neg_pos; auto.
    destruct a as [a [_ _]].
    destruct a0 as [_ [_ a0]].
    destruct a1 as [_ [_ a1]].
    rewrite (a H1).
    rewrite (a0 H).
    rewrite (a1 H0).
    ring.
    destruct H0.
    assert (x * y = real_0) by (rewrite H0; ring).
    destruct a as [_ [a _]].
    destruct a0 as [_ [_ a0]].
    destruct a1 as [_ [a1 _]].
    rewrite (a H1).
    rewrite (a1 H0).
    ring.

    assert (x * y < real_0).
    apply real_lt_neg_mult_pos_neg; auto.
    destruct a as [_ [_ a]].
    destruct a0 as [_ [_ a0]].
    destruct a1 as [a1 [_ _]].
    rewrite (a H1), (a0 H), (a1 H0).
    ring.
    destruct H.
    assert (x * y = real_0) by (rewrite H; ring).
    destruct a as [_ [a _]].
    destruct a0 as [_ [a0 _]].
    destruct a1 as [a1 [_ _]].
    rewrite (a H0), (a0 H).
    ring.
    destruct (real_total_order y real_0).
    assert (x * y < real_0).
    apply real_lt_pos_mult_neg_neg; auto.
    destruct a as [_ [_ a]].
    destruct a0 as [a0 [_ _]].
    destruct a1 as [_ [_ a1]].
    rewrite (a H1).
    rewrite (a0 H).
    rewrite (a1 H0).
    ring.
    destruct H0.
    assert (x * y = real_0) by (rewrite H0; ring).
    destruct a as [_ [a _]].
    destruct a0 as [_ [_ a0]].
    destruct a1 as [_ [a1 _]].
    rewrite (a H1).
    rewrite (a1 H0).
    ring.

    assert (x * y > real_0).
    apply real_lt_pos_mult_pos_pos; auto.
    destruct a as [a [_ _]].
    destruct a0 as [a0 [_ _]].
    destruct a1 as [a1 [_ _]].
    rewrite (a H1), (a0 H), (a1 H0).
    ring.
  Defined.

  Lemma abs_pos_id : forall x : Real, real_0 <= x -> abs x = x.
  Proof.
    intros.
    unfold abs.
    destruct (abs_prop (x)).
    destruct a as [a [b _]].
    destruct H.
    exact (a H).
    induction H.
    rewrite (b eq_refl).
    auto.
  Defined.

  Lemma abs_neg_id_neg : forall x : Real, real_0 > x -> abs x = - x.
  Proof.
    intros.
    unfold abs.
    destruct (abs_prop (x)).
    destruct a as [_ [_ a]].
    exact (a H).
  Defined.

  Lemma dist_scale : forall x y s : Real, s > real_0 -> s * dist x y = dist (s * x) (s * y).
  Proof.
    intros.
    unfold dist.
    replace (s * x - s * y) with (s * (x - y)) by ring.
    rewrite abs_mult.
    rewrite (abs_pos_id s).
    auto.
    left; auto.
  Defined.

  Lemma IZreal_dist : forall z1 z2 : Z, dist (IZreal z1) (IZreal z2) = IZreal (Z.abs (z1 - z2)%Z).
  Proof.
    intros.
    unfold dist.
    unfold real_minus.
    rewrite <- (IZ_asym z2).
    rewrite <- IZreal_hom.
    replace (z1 + - z2)%Z with (z1 - z2)%Z by auto.
    pose (z := (z1 - z2)%Z).
    fold z.
    assert (0 <= z \/ z < 0)%Z by lia.
    destruct H.
    assert (Z.abs z = z) by lia.
    rewrite H0.
    apply abs_pos_id.
    replace real_0 with (IZreal 0) by ring.
    rewrite IZreal_le.
    auto.
    assert (Z.abs z = - z)%Z by lia.
    rewrite H0.
    rewrite IZ_asym.
    rewrite abs_neg_id_neg.
    auto.
    replace (real_0) with (IZreal 0) by ring.
    apply IZreal_lt_aux.
    auto.
  Defined.

End RealMetric.

Global Hint Resolve abs_pos dist_pos_t: real.
Global Hint Resolve dist_prop: real.
Global Hint Resolve  dist_pos dist_symm dist_tri dist_zero: real.
Global Hint Resolve real_metric_sand: real.
Global Hint Resolve real_metric_plus_inv: real.
Global Hint Resolve real_metric_or: real.
Global Hint Resolve real_metric_Or: real.
Global Hint Resolve real_metric_gtgt_sand: real.
Global Hint Resolve real_metric_minus_inv: real.
Global Hint Resolve lt_metric: real.
Global Hint Resolve le_metric: real.
Global Hint Resolve dist_0_1: real.
Global Hint Resolve dist_1_0: real.