I am trying to prove this :
Goal forall a : R, (forall e : R, e > 0 /\ Rabs a <= e) -> a = 0.
This is what I've done so far :
Goal forall a : R, (forall e : R, e > 0 /\ Rabs a <= e) -> a = 0.
Proof.
intros a H.
destruct (classic (a = 0)) as [a_eq_0 | a_neq_0].
- trivial.
- apply (Rabs_pos_lt a) in a_neq_0 as Rabs_a_gt_0.
pose (e := Rabs a / 2).
cut (Rabs a <= e).
* intro absurd_ineq.
cbv [e] in absurd_ineq.
apply (Rmult_le_compat_r (/(Rabs a))) in absurd_ineq.
unfold Rdiv in absurd_ineq.
rewrite (Rinv_r (Rabs a) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
rewrite (Rinv_r_simpl_m (Rabs a) (/2) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
With the current goal being :
2 goals
a : R
H : forall e : R, e > 0 /\ Rabs a <= e
a_neq_0 : a <> 0
Rabs_a_gt_0 : 0 < Rabs a
e := Rabs a / 2 : R
absurd_ineq : 1 <= / 2
============================
a = 0
goal 2 is:
0 <= / Rabs a
Given absurd_ineq : 1 <= / 2, how can I tell Coq that this comparison evaluates to False, in order to then use the contradiction tactic ?
I have tried using vm_compute and cbv in hope that absurd_ineq is simplified, evaluated, to False, but no chance.
Thanks.
EDIT :
The statement forall a : R, (forall e : R, e > 0 /\ Rabs a <= e) -> a = 0 wasn't the right one, forall a : R, (forall e : R, e > 0 -> Rabs a <= e) -> a = 0 was.
Here's the proof :
Goal :
forall a : R, (forall e : R, e > 0 -> Rabs a <= e) -> a = 0.
Proof.
intros a H.
destruct (classic (a = 0)) as [a_eq_0 | a_neq_0].
- trivial.
- apply (Rabs_pos_lt a) in a_neq_0 as Rabs_a_spos.
pose (e := Rabs a / 2).
cut (Rabs a <= e).
* intro absurd_ineq.
cbv [e] in absurd_ineq.
apply (Rmult_le_compat_r (/(Rabs a))) in absurd_ineq; [| lra].
unfold Rdiv in absurd_ineq.
rewrite (Rinv_r (Rabs a) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
rewrite (Rinv_r_simpl_m (Rabs a) (/2) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
lra.
* specialize (H e).
apply Rlt_gt in Rabs_a_spos.
apply Rgt_ge in Rabs_a_spos as Rabs_a_pos.
cbv [e] in *.
lra.
Qed.```
part of Coq's real numbers are defined axiomatically (see e.g. here: https://coq.inria.fr/stdlib/Coq.Reals.Rdefinitions.html). This means that computation does not work as straight-forwardly as it works with e.g. integers or natural numbers.
In general, I tend to use the micromega tools for solving such trivial goals. You can find their full documentation here: https://coq.inria.fr/refman/addendum/micromega.html
I found the tactic lra to be most helpful. For your particular example, the following code works for me:
From Coq
Require Export Reals.Reals micromega.Psatz.
Goal forall a:R, (forall e:R, Rgt e R0 /\ Rle (Rabs a) e) -> a = R0.
Proof.
intros a H.
destruct (Req_dec a R0 ) as [a_eq_0 | a_neq_0].
- trivial.
- apply (Rabs_pos_lt a) in a_neq_0 as Rabs_a_gt_0.
pose (e := Rdiv (Rabs a) 2).
cut (Rle (Rabs a) e).
* intro absurd_ineq.
cbv [e] in absurd_ineq.
apply (Rmult_le_compat_r (/(Rabs a))) in absurd_ineq.
unfold Rdiv in absurd_ineq.
rewrite (Rinv_r (Rabs a) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
rewrite (Rinv_r_simpl_m (Rabs a) (/2) (Rabs_no_R0 a a_neq_0)) in absurd_ineq.
lra. lra.
* specialize (H e). lra.
Qed.
Is there an issue in the statement you want to prove (e.g. a conjunction instead of an implication) ? The lemma looks to be trivial as it is stated, and its proof doesn't use many knowledge about the reals.
Goal forall a:R, (forall e:R, Rgt e R0 /\ Rle (Rabs a) e) -> a = R0.
Proof.
intros a Ha; destruct (Ha R0) as [He _];
destruct (Rgt_irrefl _ He).
Qed.
Related
I was reading the series Software Foundations by Benjamin Pierce. And in the Chapter Logic in the first book I came across a problem.
In the proof of the theorem
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
where excluded_middle refers to
Definition excluded_middle := forall P : Prop,
P \/ ~ P.
And the proof of theorem can be as follows:
Proof.
unfold excluded_middle.
intros exmid X P H x.
destruct (exmid (P x)) as [H1 | H2].
- apply H1.
- destruct H.
exists x. apply H2.
Qed.
What puzzled me is the destruct H in the second case. What does the tactic destruct do here? It seems different from What I've known about it before.
(H here is ~ (exists x : X, ~ P x)).
After using destruct H, the subgoal is tranformed from P x into exists x : X, ~ P x.
When you destruct a term of the form A -> B you get a goal for A and the goals for what destruct B would result in. not A is defined as A -> False so B is False in your case and destruct B results in no goals. So you end up with just A.
Here is a long form proof of what is going on:
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
unfold excluded_middle.
intros exmid X P H x.
destruct (exmid (P x)) as [H1 | H2].
- apply H1.
- assert(ex (fun x : X => not (P x))) as H3.
exists x. apply H2.
specialize (H H3).
destruct H.
Qed.
I'm trying to prove group axioms for Z_3 type:
Require Import Coq.Arith.PeanoNat.
Record Z_3 : Type := Z3
{
n :> nat;
proof : (Nat.ltb n 3) = true
}.
Proposition lt_0_3 : (0 <? 3) = true.
Proof.
simpl. reflexivity.
Qed.
Definition z3_0 : Z_3 := (Z3 0 lt_0_3).
Proposition lt_1_3 : (1 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_1 : Z_3 := (Z3 1 lt_1_3).
Proposition lt_2_3 : (2 <? 3) = true.
Proof.
reflexivity.
Qed.
Definition z3_2 : Z_3 := (Z3 2 lt_2_3).
Proposition three_ne_0 : 3 <> 0.
Proof.
discriminate.
Qed.
Lemma mod_upper_bound_bool : forall (a b : nat), (not (eq b O)) -> (Nat.ltb (a mod b) b) = true.
Proof.
intros a b H. apply (Nat.mod_upper_bound a b) in H. case Nat.ltb_spec0.
- reflexivity.
- intros Hcontr. contradiction.
Qed.
Definition Z3_op (x y: Z_3) : Z_3 :=
let a := (x + y) mod 3 in
Z3 a (mod_upper_bound_bool _ 3 three_ne_0).
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal.
We are almost done:
1 subgoal (ID 41)
n, m : nat
p, q : (m <? 3) = true
============================
p = q
What theorem should I use to prove that p = q?
Update 1
Theorem bool_dec :
(forall x y: bool, {x = y} + {x <> y}).
Proof.
intros x y. destruct x.
- destruct y.
+ left. reflexivity.
+ right. intro. discriminate H.
- destruct y.
+ right. intro. discriminate H.
+ left. reflexivity.
Qed.
Lemma Z3_eq n m p q : n = m -> Z3 n p = Z3 m q.
Proof.
intros H. revert p q. rewrite H. clear H. intros. apply f_equal. apply UIP_dec. apply bool_dec.
Qed.
You are probably interested in knowing that every two proofs of a decidable equality are equal. This is explained and proved here: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html
You are interested in particular in the lemma UIP_dec: https://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html#UIP_dec
Theorem UIP_dec :
forall (A:Type),
(forall x y:A, {x = y} + {x <> y}) ->
forall (x y:A) (p1 p2:x = y), p1 = p2.
You will have then to prove that equalities of booleans are decidable (i.e. that you can write a function which says whether two given booleans are equal or not) which you should also be able to find in the standard library but which should be easily provable by hand as well.
This is a different question but since you asked: bool_dec exists and even has that name!
The easy way to find it is to use the command
Search sumbool bool.
It will turn up several lemmata, including pretty early:
Bool.bool_dec: forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}
Why did I search sumbool? sumbool is the type which is written above:
{ A } + { B } := sumbool A B
You can find it using the very nice Locate command:
Locate "{".
will turn up
"{ A } + { B }" := sumbool A B : type_scope (default interpretation)
(and other notations involving "{").
I'm trying to implement a function extract which takes an expression like (f (g x y)) together with a variable e.g. y and produces a function y --> (f (g x y)) with SKI combinators. In this case, the result should be (S (K f) (g x)).
In some sense, I'm doing a conversion from lambda term to its SKI version.
I'm trying to do a typed version of this and I'm having hard times.
Set up
Types in these expressions are represented by the following inductive type
Inductive type : Type :=
| base_type : forall (n : nat), type
| arrow_type : type -> type -> type.
Basically, I have some basic types indexed by integers(base_type) and also I can create function types between them (arrow_type)
Introduce notation for function types
Notation "A --> B" := (arrow_type A B) (at level 30, right associativity).
Expression are represented by the following inductive type
Inductive term : type -> Type :=
| var : forall (n : nat) (A : type), term A
| eval : forall {A B : type}, term (A-->B) -> term A -> term B
| I : forall (A : type) , term (A --> A)
| K : forall (A B : type) , term (A --> (B --> A))
| S : forall (A X Y : type), term ((A --> X --> Y) --> (A --> X) --> A --> Y).
Here, I have again set of basic variables indexed by integers n : nat and a type A : type (not Type!)
Thus, a variable x : term X is an expression with type X.
To reduce eyesore, let's introduce notation for function evaluation
Notation "f [ x ]" := (eval f x) (at level 25, left associativity).
Introductory example
The original question can be stated more precisely as follows.
Let's start with defining with some types
Notation X := (base_type 0).
Notation Y := (base_type 1).
Define variables x y and functions f g (they can be all indexed with 0 because they all have different type)
Notation x := (var 0 X).
Notation y := (var 0 Y).
Notation g := (var 0 (X --> Y --> X)).
Notation f := (var 0 (X --> Y)).
The type of the resulting expression is Y.
Check f[g[x][y]].
My goal is to produce a function extract such that
extract f[g[x][y]] y
produces
S[K[f]][g[x]]
with type filled in
(S Y X Y)[(K (X-->Y) Y)[f]][g[x]]
Equality on type and term
To proceed with an attempt to define extract I need to define equality on type and term.
Require Import Arith.EqNat.
Open Scope bool_scope.
Fixpoint eq_type (A B : type) : bool :=
match A, B with
| base_type n, base_type m => beq_nat n m
| arrow_type X Y, arrow_type X' Y' => (eq_type X X') && (eq_type Y Y')
| _, _ => false
end.
Fixpoint eq_term {A B : type} (a : term A) (b : term B) : bool :=
match a, b with
| var n X , var n' X' => (beq_nat n n') && (eq_type X X')
| eval X Y f x , eval X' Y' f' x' => (eq_type X X') && (eq_type Y Y') && (eq_term f f') && (eq_term x x')
| I X , I X' => (eq_type X X')
| K X Y , K X' Y' => (eq_type X X') && (eq_type Y Y')
| S Z X Y , S Z' X' Y' => (eq_type X X') && (eq_type Y Y') && (eq_type Z Z')
| _ , _ => false
end.
Attempt at implementing extract
The 'implementation' is quite straightforward
Fixpoint extract {A B : type} (expr : term B) (val : term A) : term (A-->B) :=
if (eq_term expr val)
then (I A)
else
match expr with
| eval X Y f x => (S A X Y)[extract f val][extract x val]
| _ => (K B A)[expr]
end.
There are two problems
When returning I A: type of I A is A --> A not A --> B as promised, but in that particular case I should be able to prove that B and A are the same.
When returning (S A X Y)[...: the returning value is A --> Y and not A --> B, but again I should be able to prove that Y is equal to B.
How can I prove B=A and Y=B in those particular cases such that the function definition is accepted?
What you can do is turn eq_type and eq_term from boolean functions into decision procedures for equality. Currently, as far as I can tell, your equality is entirely syntactic. So you could simply use Coq's notion of equality to talk about equality of terms and types. Then, you can write:
Definition eq_type_dec (A B : type) : { A = B } + { A <> B }.
You pretty much do the pattern match on A and B, then return left eq_refl for the cases of equality, and right ... in the other cases, where ... is whatever you need to do to prove disequality.
Do the same and define eq_term_dec. You have two choices here, either making the equality of types intrinsic or extrinsic:
Definition eq_term_dec (A B : type) (a : A) (b : B) :
{ (A = B) * (existT (fun t => t) A a = existT (fun t => t) B b) }
+
{ (A <> B) + (existT (fun t => t) A a <> existT (fun t => t) B b) }.
or:
Definition eq_term_dec (A : type) (a b : term A) : { a = b } + { a <> b }.
The first one seems pretty awful to write, but gives you more flexibility. I'd probably favor the latter, and use it under a eq_type_check when dealing with possibly-unequal types.
Once you have those, you can turn your if into a dependent match:
Fixpoint extract {A B : type} (expr : term B) (val : term A) : term (A-->B) :=
match eq_type_dec A B with
| left eqAB =>
match eqAB
in eq _ B1
return term B1 -> term (A --> B1)
with
| eq_refl => fun expr1 => (* now expr1 : A *)
match eq_expr_dec _ _ expr1 val with
| left eqab => I A
| right neqab => (* ... *)
end
end expr (* note here we pass the values that must change type *)
| right neqAB => (* ... *)
end.
There might still be quite a bit of work in the branches I have elided. You might look at different ways of doing such dependently-typed programming, either manually like I have shown here, or using dependent elimination tactics, or using the recursors of those types.
EDIT
To answer your comment, here are twp ways I know of writing eq_term_dec. One way is to use the Program extension of Coq, which adds one axiom and becomes much more capable of dealing with dependent types:
Require Import Program.Equality.
Fixpoint eq_term_dec (A : type) (a b : term A) : { a = b } + { a <> b }.
dependent induction a; dependent induction b; try (right ; congruence).
- destruct (PeanoNat.Nat.eq_dec n n0); [ left | right ]; congruence.
The other way is to actually figure out the dependently-typed term you need. There has to be a way of doing so using tactics, but I'm not quite sure how to proceed, however, I know how to write the term. It is not for the faint of heart, and I don't expect you to understand what's going on until after you have become familiar with dependent pattern-matching and the "convoy pattern". Here it is if you want to see what this looks like:
Fixpoint eq_term_dec (A : type) (a b : term A) : { a = b } + { a <> b }.
revert b.
destruct a.
{
destruct b; try (right ; congruence).
destruct (PeanoNat.Nat.eq_dec n n0) ; [ left | right ] ; congruence.
}
{ destruct b; admit. (* skipping this, it's easy *) }
{
(* Here is the complication: *)
(* `b` has type `term (A -> A)` *)
(* If you abstract over its type, the goal is ill-typed, because the equality *)
(* `I A = b` is at type `A -> A`. *)
intros b.
refine (
(fun (T : type) (ia : term T) (b : term T) =>
match b
as b1
in term T1
return forall (ia0 : term T1),
match T1 as T2 return term T2 -> term T2 -> Type with
| arrow_type Foo Bar => fun ia1 b2 => {ia1 = b2} + {ia1 <> b2}
| _ => fun _ _ => True
end ia0 b1
with
| var n a => fun b => _
| eval h a => fun b => _
| I A => fun b => _
| K A B => fun b => _
| S A B C => fun b => _
end ia
) (A --> A) (I A) b
).
(* from now on it's easy to proceed *)
destruct a.
easy.
destruct b; try ( right ; congruence ).
destruct (PeanoNat.Nat.eq_dec n n0) ; [ left | right ] ; congruence.
(* one more to show it's easy *)
destruct t0.
easy.
destruct b; try ( right ; congruence ).
(* etc... *)
I have a solution, it is not pretty but it seems to work. Especially, the proof of eq_term_dec is super long and ugly.
If anyone is interested, my solution:
Inductive type : Type :=
| base_type : forall (n : nat), type
| arrow_type : type -> type -> type.
Notation "A --> B" := (arrow_type A B) (at level 30, right associativity).
Inductive term : type -> Type :=
| var : forall (n : nat) (A : type), term A
| eval : forall {A B : type}, term (A-->B) -> term A -> term B
| I : forall {A : type} , term (A --> A)
| K : forall {A B : type} , term (A --> (B --> A))
| S : forall {A X Y : type}, term ((A --> X --> Y) --> ((A --> X) --> (A --> Y))).
(* Coercion term : type >-> Sortclass. *)
Notation "n :: A" := (var n A).
Notation "f [ x ]" := (eval f x) (at level 25, left associativity).
Fixpoint eq_type_dec (A B : type) : {A = B} + {A <> B}.
Proof.
decide equality.
decide equality.
Defined.
Require Import Coq.Logic.Eqdep.
Fixpoint eq_term_dec {A B : type} (a : term A) (b : term B) :
( (A = B) * (existT (fun T : type => term T) A a = existT (fun T : type => term T) B b) )
+
( (A <> B) + (existT (fun T : type => term T) A a <> existT (fun T : type => term T) B b) ).
Proof.
case a as [n X| X Y f x | X | X Y | Z X Y], b as [n' X'| X' Y' f' x' | X' | X' Y' | Z' X' Y'].
(* var n X ? var n' X'*)
- assert (ndec : {n=n'} + {n<>n'}) by decide equality.
pose (Xdec := eq_type_dec X X').
destruct ndec as [eqn | neqn], Xdec as [eqX | neqX].
left.
rewrite eqn.
rewrite eqX.
split; reflexivity.
right; left. apply neqX.
right; right.
intro H; inversion H as [H1]. auto.
right; left. apply neqX.
- right; right; intro H; inversion H. (* n ? f[x] *)
- right; right; intro H; inversion H. (* n ? I *)
- right; right; intro H; inversion H. (* n ? K *)
- right; right; intro H; inversion H. (* n ? S *)
- right; right; intro H; inversion H. (* f[x] ? n *)
- pose (xdec := eq_term_dec _ _ x x').
pose (fdec := eq_term_dec _ _ f f').
destruct xdec, fdec.
(* x = x' && f = f' *)
left.
split.
apply fst in p0.
inversion p0.
auto.
apply snd in p0.
inversion p0.
revert dependent x.
revert dependent f.
rewrite H0.
rewrite H1.
intros.
apply snd in p.
assert (x=x'). apply inj_pair2; apply p.
assert (f=f'). apply inj_pair2; apply p0.
rewrite H, H3. auto.
right.
destruct s.
left. intro.
apply fst in p.
assert (X-->Y = X' --> Y').
rewrite H, p.
auto. auto.
right. intro.
inversion H.
apply n.
revert dependent x.
revert dependent f.
rewrite H1.
rewrite H2.
intros.
apply inj_pair2 in H4.
apply inj_pair2 in H4.
rewrite H4.
auto.
right.
destruct s.
inversion p.
inversion H.
auto.
inversion p.
inversion H0.
revert dependent x.
revert dependent f.
rewrite H2.
rewrite H3.
intros.
apply inj_pair2 in H0.
rewrite H0.
right.
intro.
apply inj_pair2 in H1.
inversion H1. auto.
destruct s, s0.
right. right.
intro. inversion H. auto.
right. right.
intro. inversion H. auto.
right. right.
intro. inversion H. auto.
right. right.
intro. inversion H. auto.
- right; right; intro H; inversion H. (* f[x] ? I *)
- right; right; intro H; inversion H. (* f[x] ? K *)
- right; right; intro H; inversion H. (* f[x] ? S *)
- right; right; intro H; inversion H. (* I ? n *)
- right; right; intro H; inversion H. (* I ? f[x] *)
- pose (Xdec := eq_type_dec X X'). (* I ? I *)
destruct Xdec.
left; split; rewrite e; auto.
right; left. intro. inversion H. auto.
- right; right; intro H; inversion H. (* I ? K *)
- right; right; intro H; inversion H. (* I ? S *)
- right; right; intro H; inversion H. (* K ? n *)
- right; right; intro H; inversion H. (* K ? f[x] *)
- right; right; intro H; inversion H. (* K ? I *)
- pose (Xdec := eq_type_dec X X').
pose (Ydec := eq_type_dec Y Y').
destruct Xdec, Ydec.
left; split; rewrite e; rewrite e0; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
- right; right; intro H; inversion H. (* K ? S *)
- right; right; intro H; inversion H. (* S ? n *)
- right; right; intro H; inversion H. (* S ? f[x] *)
- right; right; intro H; inversion H. (* S ? I *)
- right; right; intro H; inversion H. (* S ? K *)
- pose (Xdec := eq_type_dec X X').
pose (Ydec := eq_type_dec Y Y').
pose (Zdec := eq_type_dec Z Z').
destruct Xdec, Ydec, Zdec.
left; split; rewrite e; rewrite e0; rewrite e1; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
right; left; intro; inversion H; auto.
Defined.
Fixpoint extract {A B : type} (expr : term B) (val : term A) : term (A-->B).
Proof.
pose (ab_dec := eq_term_dec expr val).
destruct ab_dec.
(* expr is equal to val *)
apply fst in p; rewrite p; apply I.
(* expr is not equal to val *)
inversion expr as [n X | X Y f x | X | X Y | Z X Y].
(* expr is just a constant, i.e. expr = var n X *)
apply (K[expr]).
(* expr is a function evaluation, i.e. expr = f[x]*)
apply (S[extract _ _ f val][extract _ _ x val]).
(* expr is identity, i.e. expr = I *)
rewrite H; apply (K[expr]).
(* expr is constant function, i.e. expr = K *)
rewrite H; apply (K[expr]).
(* expr is constant function, i.e. expr = S *)
rewrite H; apply (K[expr]).
Defined.
Notation X := (base_type 0).
Notation Y := (base_type 1).
Notation x := (var 0 X).
Notation y := (var 0 Y).
Notation f := (var 0 (X --> Y --> X)).
Compute extract (f[x]) x. (* => S [K [f]] [I] *)
Compute extract (f[x][y]) x. (* => S [S [K [f]] [I]] [K [y]] *)
I was wondering whether Coq defined the real numbers as Cauchy sequences or Dedekind cuts, so I checked Coq.Reals.Raxioms and... none of these two. The real numbers are axiomatized, along with their operations (as Parameters and Axioms). Why is it so?
Also, the real numbers tightly rely on the notion of subset, since one of their defining properties is that is every upper bounded subset has a least upper bound. The Axiom completeness encodes those subsets as Props.
I have the impression that these Props only form the definable subsets of the reals. So does Coq only have access to definable real numbers? What exactly is this Coq's R? Analytical numbers? Algebraic numbers? Arithmetical numbers?
If, as I suspect, Coq only has a countable subset of the reals (because there are only countably many Props), that makes an infinitesimal part of the reals. Is it fit for theories that deeply exploit the structure of the ZFC real numbers, such as fractals, chaos theory or the Lebesgue measure?
EDIT
Here is a naive construction of the reals by Dedekind cuts.
Require Import Coq.QArith.QArith_base.
(* An interval of rationals, unbounded below, bounded above.
Its upper limit is the definition of a real number. *)
Definition DedekindCut (part : Q -> Prop) : Prop :=
(forall x y : Q, x < y /\ part(y) -> part(x))
/\ (exists q : Q, forall x : Q, part(x) -> x < q).
(* Square root of 2 *)
Definition sqrt_2 (x : Q) : Prop := x*x < 2#1 \/ x < 0.
Lemma square_increasing : forall x y : Q, 0 <= x -> 0 <= y -> x <= y -> x*x <= y*y.
Proof.
intros x y H H0 H1. apply (Qle_trans (x*x) (y*x) (y*y)).
apply (Qmult_le_compat_r x y x); assumption. rewrite -> (Qmult_comm y x).
apply (Qmult_le_compat_r x y y); assumption.
Qed.
Lemma sqrt_increasing : forall x y : Q, 0 <= x -> 0 <= y -> x*x < y*y -> x < y.
Proof.
intros x y H H0 H1. destruct (Q_dec y x) as [[eq|eq0]|eq1].
- exfalso. apply Qlt_le_weak in eq. apply square_increasing in eq. apply Qle_not_lt in eq.
contradiction. assumption. assumption.
- assumption.
- exfalso. rewrite -> eq1 in H1. apply Qlt_irrefl in H1. contradiction.
Qed.
Lemma sqrt_2_is_dc : DedekindCut sqrt_2.
Proof.
split.
- intros x y [H H0]. destruct (Qlt_le_dec y 0). right.
apply (Qlt_trans x y 0); assumption. destruct (Qlt_le_dec x 0). right. assumption.
left. destruct H0. apply (Qle_lt_trans (x*x) (y*y) (2#1)).
apply square_increasing. assumption. assumption. apply Qlt_le_weak. assumption.
assumption. exfalso. apply Qle_not_lt in q. contradiction.
- exists (2#1). intros. destruct (Qlt_le_dec x 0). apply (Qlt_trans x 0 (2#1)). assumption.
reflexivity. destruct H. apply (Qlt_trans (x*x) (2#1) ((2#1) * (2#1))) in H.
apply sqrt_increasing. assumption. discriminate. assumption. split. apply (Qlt_trans x 0 (2#1)).
assumption. reflexivity.
Qed.
(* The order on Dedekind cuts : any point of the lower one is a limit
of the higher one. *)
Definition DCleq (l h : Q -> Prop) : Prop :=
DedekindCut(l) /\ DedekindCut(h)
/\ (forall x eta : Q, l x -> exists y : Q, h y /\ y < x /\ x - y < eta).
(* The equality on Dedekind cuts : anti-symmetry of the order *)
Definition DCeq (d e : Q -> Prop) : Prop :=
DedekindCut(d) /\ DedekindCut(e) /\ DCleq d e /\ DCleq e d.
(* The addition of Dedekind cuts *)
Definition dc_add (x y : Q -> Prop) (a : Q) : Prop :=
exists u v : Q, x u /\ y v /\ a <= u + v.
EDIT
And here is a proof in Coq that R is uncountable. I don't really know what to think of it, since Props are obviously countable from outside Coq. This is probably a manifestation of Skolem's paradox, as Arthur Azevedo De Amorim suggests. The way I would put it is that the bijection between R and nat cannot be written in Coq. Maybe for similar reasons to the impossibility of writing a Coq interpreter in Coq.
Require Import Coq.Reals.Rdefinitions.
Require Import Coq.Reals.Raxioms.
Require Import Rfunctions.
Require Import Coq.Reals.RIneq.
(* Well-order for decidable nat -> Prop. They have minimums. *)
Fixpoint smallest_prop_elem (P : nat -> Prop) (fuel start : nat)
(dec : forall k : nat, {P k} + {~P k}) : nat :=
match fuel with
| O => start
| S fuel' => if dec start then start else smallest_prop_elem P fuel' (S start) dec
end.
Lemma below_smallest_not :
forall (P : nat -> Prop) (fuel n l : nat) (dec : forall k : nat, {P k} + {~P k}),
l <= n -> n < smallest_prop_elem P fuel l dec -> ~P n.
Proof.
induction fuel.
- intros n l dec H H0 H1. simpl in H0. apply le_not_lt in H. contradiction.
- intros n l dec H H0. simpl in H0. destruct (dec l).
+ exfalso. apply le_not_lt in H. contradiction.
+ apply le_lt_or_eq in H. destruct H. apply (IHfuel n (S l) dec). assumption.
assumption. subst. assumption.
Qed.
Lemma smallest_below_fuel :
forall (P : nat -> Prop) (fuel l : nat) (dec : forall k : nat, {P k} + {~P k}),
smallest_prop_elem P fuel l dec <= fuel + l.
Proof.
induction fuel.
- intros. reflexivity.
- intros. simpl. destruct (dec l). assert (forall k : nat, l <= S (k + l)).
{ induction k. simpl. apply le_S. apply le_n. apply (le_trans l (S (k+l)) (S (S k + l))).
apply IHk. apply le_n_S. simpl. apply le_S. apply le_n. }
apply H. specialize (IHfuel (S l) dec). rewrite -> Nat.add_succ_r in IHfuel. assumption.
Qed.
Lemma smallest_found :
forall (P : nat -> Prop) (dec : forall k : nat, {P k} + {~P k}) (fuel l : nat),
smallest_prop_elem P fuel l dec < fuel+l -> P (smallest_prop_elem P fuel l dec).
Proof.
induction fuel.
- intros. simpl in H. apply lt_irrefl in H. contradiction.
- intros. simpl. simpl in H. destruct (dec l). assumption. apply IHfuel.
rewrite -> Nat.add_succ_r. assumption.
Qed.
(* Tired to search in the library... *)
Lemma le_or_lt : forall m n : nat, n <= m -> n < m \/ n = m.
Proof.
induction m.
- intros. inversion H. right. reflexivity.
- intros. destruct n. left. apply le_n_S. apply le_0_n. apply le_pred in H. simpl in H.
destruct (IHm n H). left. apply le_n_S. assumption. subst. right. reflexivity.
Qed.
Lemma smallest_sat (P : nat -> Prop) (n : nat) (dec : forall k : nat, {P k} + {~P k}) :
P n -> P (smallest_prop_elem P n 0 dec).
Proof.
intros. pose proof (smallest_below_fuel P n 0 dec). rewrite -> Nat.add_0_r in H0.
apply le_or_lt in H0 as [H0|H1]. apply (smallest_found P). rewrite -> Nat.add_0_r. assumption.
rewrite -> H1. assumption.
Qed.
(* Now the proof that R is uncountable. *)
(* We define the enumerations of the real numbers, to prove that they don't exist. *)
Definition R_enum (u : nat -> R) (v : R -> nat) : Prop :=
(forall x : R, u (v x) = x) /\ (forall n : nat, v (u n) = n).
Definition in_holed_interval (a b h : R) (u : nat -> R) (n : nat) : Prop :=
Rlt a (u n) /\ Rlt (u n) b /\ u n <> h.
(* Here we use axiom total_order_T *)
Lemma in_holed_interval_dec (a b h : R) (u : nat -> R) (n : nat)
: {in_holed_interval a b h u n} + {~in_holed_interval a b h u n}.
Proof.
destruct (total_order_T a (u n)) as [[l|e]|hi].
- destruct (total_order_T b (u n)) as [[lb|eb]|hb].
+ right. intro H. destruct H. destruct H0. apply Rlt_asym in H0. contradiction.
+ subst. right. intro H. destruct H. destruct H0.
pose proof (Rlt_asym (u n) (u n) H0). contradiction.
+ destruct (Req_EM_T h (u n)). subst. right. intro H. destruct H. destruct H0.
exact (H1 eq_refl). left. split. assumption. split. assumption. intro H. subst.
exact (n0 eq_refl).
- subst. right. intro H. destruct H. pose proof (Rlt_asym (u n) (u n) H). contradiction.
- right. intro H. destruct H. apply Rlt_asym in H. contradiction.
Qed.
Definition point_in_holed_interval (a b h : R) : R :=
if Req_EM_T h (Rdiv (Rplus a b) (INR 2)) then (Rdiv (Rplus a h) (INR 2))
else (Rdiv (Rplus a b) (INR 2)).
Lemma middle_in_interval : forall a b : R, Rlt a b -> (a < (a + b) / INR 2 < b)%R.
Proof.
intros.
assert (twoNotZero: INR 2 <> 0%R).
{ apply not_0_INR. intro abs. inversion abs. }
assert (twoAboveZero : (0 < / INR 2)%R).
{ apply Rinv_0_lt_compat. apply lt_0_INR. apply le_n_S. apply le_S. apply le_n. }
assert (double : forall x : R, Rplus x x = ((INR 2) * x)%R).
{ intro x. rewrite -> S_O_plus_INR. rewrite -> Rmult_plus_distr_r.
rewrite -> Rmult_1_l. reflexivity. }
split.
- assert (a + a < a + b)%R. { apply (Rplus_lt_compat_l a a b). assumption. }
rewrite -> double in H0. apply (Rmult_lt_compat_l (/ (INR 2))) in H0.
rewrite <- Rmult_assoc in H0. rewrite -> Rinv_l in H0. simpl in H0.
rewrite -> Rmult_1_l in H0. rewrite -> Rmult_comm in H0. assumption.
assumption. assumption.
- assert (b + a < b + b)%R. { apply (Rplus_lt_compat_l b a b). assumption. }
rewrite -> Rplus_comm in H0. rewrite -> double in H0.
apply (Rmult_lt_compat_l (/ (INR 2))) in H0.
rewrite <- Rmult_assoc in H0. rewrite -> Rinv_l in H0. simpl in H0.
rewrite -> Rmult_1_l in H0. rewrite -> Rmult_comm in H0. assumption.
assumption. assumption.
Qed.
Lemma point_in_holed_interval_works (a b h : R) :
Rlt a b -> let p := point_in_holed_interval a b h in
Rlt a p /\ Rlt p b /\ p <> h.
Proof.
intros. unfold point_in_holed_interval in p.
pose proof (middle_in_interval a b H). destruct H0.
destruct (Req_EM_T h ((a + b) / INR 2)).
- (* middle hole, p is quarter *) subst.
pose proof (middle_in_interval a ((a + b) / INR 2) H0). destruct H2.
split. assumption. split. apply (Rlt_trans p ((a + b) / INR 2)%R). assumption.
assumption. apply Rlt_not_eq. assumption.
- split. assumption. split. assumption. intro abs. subst. contradiction.
Qed.
(* An enumeration of R reaches any open interval of R,
extract the first two real numbers in it. *)
Definition first_in_holed_interval (u : nat -> R) (v : R -> nat) (a b h : R) : nat :=
smallest_prop_elem (in_holed_interval a b h u)
(v (point_in_holed_interval a b h))
0 (in_holed_interval_dec a b h u).
Lemma first_in_holed_interval_works (u : nat -> R) (v : R -> nat) (a b h : R) :
R_enum u v -> Rlt a b ->
let c := first_in_holed_interval u v a b h in
in_holed_interval a b h u c
/\ forall x:R, Rlt a x -> Rlt x b -> x <> h -> x <> u c -> c < v x.
Proof.
intros. split.
- apply (smallest_sat (in_holed_interval a b h u)
(v (point_in_holed_interval a b h))
(in_holed_interval_dec a b h u)).
unfold in_holed_interval. destruct H. rewrite -> H.
apply point_in_holed_interval_works. assumption.
- intros. destruct (c ?= v x) eqn:order.
+ exfalso. apply Nat.compare_eq_iff in order. rewrite -> order in H4.
destruct H. rewrite -> H in H4. exact (H4 eq_refl).
+ apply Nat.compare_lt_iff in order. assumption.
+ exfalso. apply Nat.compare_gt_iff in order.
unfold first_in_holed_interval in c.
pose proof (below_smallest_not (in_holed_interval a b h u)
(v (point_in_holed_interval a b h))
(v x)
0 (in_holed_interval_dec a b h u)
(le_0_n (v x)) order).
destruct H. assert (in_holed_interval a b h u (v x)).
{ split. rewrite -> H. assumption. rewrite -> H. split; assumption. }
contradiction.
Qed.
Lemma split_couple_eq : forall a b c d : R, (a,b) = (c,d) -> a = c /\ b = d.
Proof.
intros. injection H. intros. split. subst. reflexivity. subst. reflexivity.
Qed.
Definition first_two_in_interval (u : nat -> R) (v : R -> nat) (a b : R) : prod R R :=
let first_index : nat := first_in_holed_interval u v a b b in
let second_index := first_in_holed_interval u v a b (u first_index) in
if Rle_dec (u first_index) (u second_index) then (u first_index, u second_index)
else (u second_index, u first_index).
Lemma first_two_in_interval_works (u : nat -> R) (v : R -> nat) (a b : R)
: R_enum u v -> Rlt a b
-> let (c,d) := first_two_in_interval u v a b in
Rlt a c /\ Rlt c b
/\ Rlt a d /\ Rlt d b
/\ Rlt c d
/\ (forall x:R, Rlt a x -> Rlt x b -> x <> c -> x <> d -> v c < v x).
Proof.
intros. destruct (first_two_in_interval u v a b) eqn:ft.
unfold first_two_in_interval in ft.
destruct (Rle_dec (u (first_in_holed_interval u v a b b))
(u (first_in_holed_interval u v a b
(u (first_in_holed_interval u v a b b))))).
- apply split_couple_eq in ft as [ft ft0]. rewrite -> ft in r1.
pose proof (first_in_holed_interval_works u v a b b H H0). destruct H1.
destruct H1. rewrite -> ft in H1. rewrite -> ft in H3. split. apply H1.
destruct H3. split. apply H3. rewrite -> ft in ft0.
pose proof (first_in_holed_interval_works u v a b r H H0). destruct H5.
destruct H5. rewrite -> ft0 in H5. split. assumption. rewrite -> ft0 in H7.
destruct H7. split. assumption. rewrite -> ft0 in r1. destruct r1. split.
assumption. intros. assert (first_in_holed_interval u v a b b = v r).
{ rewrite <- ft. destruct H. rewrite -> H14. reflexivity. }
rewrite <- H14. apply H2. assumption. assumption. intro abs. subst.
apply Rlt_irrefl in H11. contradiction. rewrite -> ft. assumption.
exfalso. rewrite -> H9 in H8. exact (H8 eq_refl).
- (* ugly copy paste *)
apply split_couple_eq in ft as [ft ft0]. apply Rnot_le_lt in n.
rewrite -> ft in n. rewrite -> ft0 in ft.
pose proof (first_in_holed_interval_works u v a b b H H0). destruct H1.
destruct H1. rewrite -> ft0 in H1. rewrite -> ft0 in H3.
pose proof (first_in_holed_interval_works u v a b r0 H H0). destruct H4.
destruct H4. rewrite -> ft in H4. rewrite -> ft in H6.
split. assumption. destruct H6. split. assumption. split. assumption.
destruct H3. split. assumption. rewrite -> ft0 in n. split. assumption.
intros. assert (first_in_holed_interval u v a b r0 = v r).
{ rewrite <- ft. destruct H. rewrite -> H13. reflexivity. }
rewrite <- H13. apply H5. assumption. assumption. intro abs. rewrite -> abs in H12.
exact (H12 eq_refl). rewrite -> ft. assumption.
Qed.
(* If u,v is an enumeration of R, these sequences tear the segment [0,1].
The first sequence is increasing, the second decreasing. The first is below the second.
Therefore the first sequence has a limit, a least upper bound b, that u cannot reach,
which contradicts u (v b) = b. *)
Fixpoint tearing_sequences (u : nat -> R) (v : R -> nat) (n : nat) : prod R R :=
match n with
| 0 => (INR 0, INR 1)
| S p => let (a,b) := tearing_sequences u v p in
first_two_in_interval u v a b
end.
Lemma tearing_sequences_ordered (u : nat -> R) (v : R -> nat) :
R_enum u v -> forall n : nat, let (a,b) := tearing_sequences u v n in Rlt a b.
Proof.
induction n.
- apply Rlt_0_1.
- destruct (tearing_sequences u v n) eqn:tear. destruct (tearing_sequences u v (S n)) eqn:tearS.
simpl in tearS. rewrite -> tear in tearS.
pose proof (first_two_in_interval_works u v r r0 H IHn). rewrite -> tearS in H0.
apply H0.
Qed.
(* The first tearing sequence in increasing, the second decreasing *)
Lemma tearing_sequences_inc_dec (u : nat -> R) (v : R -> nat) :
R_enum u v ->
forall n : nat, Rlt (fst (tearing_sequences u v n)) (fst (tearing_sequences u v (S n)))
/\ Rlt (snd (tearing_sequences u v (S n))) (snd (tearing_sequences u v n)).
Proof.
intros. destruct (tearing_sequences u v (S n)) eqn:tear. simpl. simpl in tear.
destruct (tearing_sequences u v n) eqn:tearP. simpl.
pose proof (tearing_sequences_ordered u v H n). rewrite -> tearP in H0.
pose proof (first_two_in_interval_works u v r1 r2 H H0). rewrite -> tear in H1.
destruct H1 as [H1 [H2 [H3 [H4 H5]]]]. destruct H. split; assumption.
Qed.
Lemma split_lt_succ : forall n m : nat, lt n (S m) -> lt n m \/ n = m.
Proof.
intros n m. generalize dependent n. induction m.
- intros. destruct n. right. reflexivity. exfalso. inversion H. inversion H1.
- intros. destruct n. left. unfold lt. apply le_n_S. apply le_0_n.
apply lt_pred in H. simpl in H. specialize (IHm n H). destruct IHm. left. apply lt_n_S. assumption.
subst. right. reflexivity.
Qed.
Lemma increase_seq_transit (u : nat -> R) :
(forall n : nat, Rlt (u n) (u (S n))) -> (forall n m : nat, n < m -> Rlt (u n) (u m)).
Proof.
intros. induction m.
- intros. inversion H0.
- intros. destruct (split_lt_succ n m H0).
+ apply (Rlt_trans (u n) (u m)). apply IHm. assumption. apply H.
+ subst. apply H.
Qed.
Lemma decrease_seq_transit (u : nat -> R) :
(forall n : nat, Rlt (u (S n)) (u n)) -> (forall n m : nat, n < m -> Rlt (u m) (u n)).
Proof.
intros. induction m.
- intros. inversion H0.
- intros. destruct (split_lt_succ n m H0).
+ apply (Rlt_trans (u (S m)) (u m)). apply H. apply IHm. assumption.
+ subst. apply H.
Qed.
(* Either increase the first sequence, or decrease the second sequence,
until n = m and conclude by tearing_sequences_ordered *)
Lemma tearing_sequences_ordered_forall (u : nat -> R) (v : R -> nat) :
R_enum u v -> forall n m : nat, Rlt (fst (tearing_sequences u v n))
(snd (tearing_sequences u v m)).
Proof.
intros. destruct (n ?= m) eqn:order.
- apply Nat.compare_eq_iff in order. subst.
pose proof (tearing_sequences_ordered u v H m). destruct (tearing_sequences u v m). assumption.
- apply Nat.compare_lt_iff in order. (* increase first sequence *)
apply (Rlt_trans (fst (tearing_sequences u v n)) (fst (tearing_sequences u v m))).
remember (fun n => fst (tearing_sequences u v n)) as fseq.
pose proof (increase_seq_transit fseq). assert ((forall n : nat, (fseq n < fseq (S n))%R)).
{ intro n0. rewrite -> Heqfseq. apply tearing_sequences_inc_dec. assumption. }
specialize (H0 H1). rewrite -> Heqfseq in H0. apply H0. assumption.
pose proof (tearing_sequences_ordered u v H m). destruct (tearing_sequences u v m). assumption.
- apply Nat.compare_gt_iff in order. (* decrease second sequence *)
apply (Rlt_trans (fst (tearing_sequences u v n)) (snd (tearing_sequences u v n))).
pose proof (tearing_sequences_ordered u v H n). destruct (tearing_sequences u v n). assumption.
remember (fun n => snd (tearing_sequences u v n)) as sseq.
pose proof (decrease_seq_transit sseq). assert ((forall n : nat, (sseq (S n) < sseq n)%R)).
{ intro n0. rewrite -> Heqsseq. apply tearing_sequences_inc_dec. assumption. }
specialize (H0 H1). rewrite -> Heqsseq in H0. apply H0. assumption.
Qed.
Definition tearing_elem_fst (u : nat -> R) (v : R -> nat) (x : R) :=
exists n : nat, x = fst (tearing_sequences u v n).
(* The limit of the first tearing sequence cannot be reached by u *)
Definition torn_number (u : nat -> R) (v : R -> nat) :
R_enum u v -> {m : R | is_lub (tearing_elem_fst u v) m}.
Proof.
intros. assert (bound (tearing_elem_fst u v)).
{ exists (INR 1). intros x H0. destruct H0 as [n H0]. subst. left.
apply (tearing_sequences_ordered_forall u v H n 0). }
apply (completeness (tearing_elem_fst u v) H0).
exists (INR 0). exists 0. reflexivity.
Defined.
Lemma torn_number_above_first_sequence (u : nat -> R) (v : R -> nat) (en : R_enum u v) :
forall n : nat, Rlt (fst (tearing_sequences u v n))
(proj1_sig (torn_number u v en)).
Proof.
intros. destruct (torn_number u v en) as [torn i]. simpl.
destruct (Rlt_le_dec (fst (tearing_sequences u v n)) torn). assumption. exfalso.
destruct i. (* Apply the first sequence once to make the inequality strict *)
assert (Rlt torn (fst (tearing_sequences u v (S n)))).
{ apply (Rle_lt_trans torn (fst (tearing_sequences u v n))). assumption.
apply tearing_sequences_inc_dec. assumption. }
clear r. specialize (H (fst (tearing_sequences u v (S n)))).
assert (tearing_elem_fst u v (fst (tearing_sequences u v (S n)))).
{ exists (S n). reflexivity. }
specialize (H H2). assert (Rlt torn torn).
{ apply (Rlt_le_trans torn (fst (tearing_sequences u v (S n)))); assumption. }
apply Rlt_irrefl in H3. contradiction.
Qed.
(* The torn number is between both tearing sequences, so it could have been chosen
at each step. *)
Lemma torn_number_below_second_sequence (u : nat -> R) (v : R -> nat) (en : R_enum u v) :
forall n : nat, Rlt (proj1_sig (torn_number u v en))
(snd (tearing_sequences u v n)).
Proof.
intros. destruct (torn_number u v en) as [torn i]. simpl.
destruct (Rlt_le_dec torn (snd (tearing_sequences u v n)))
as [l|h].
- assumption.
- exfalso. (* Apply the second sequence once to make the inequality strict *)
assert (Rlt (snd (tearing_sequences u v (S n))) torn).
{ apply (Rlt_le_trans (snd (tearing_sequences u v (S n))) (snd (tearing_sequences u v n)) torn).
apply (tearing_sequences_inc_dec u v en n). assumption. }
clear h. (* Then prove snd (tearing_sequences u v (S n)) is an upper bound of the first
sequence. It will yield the contradiction torn < torn. *)
assert (is_upper_bound (tearing_elem_fst u v) (snd (tearing_sequences u v (S n)))).
{ intros x H0. destruct H0. subst. left. apply tearing_sequences_ordered_forall. assumption. }
destruct i. apply H2 in H0.
pose proof (Rle_lt_trans torn (snd (tearing_sequences u v (S n))) torn H0 H).
apply Rlt_irrefl in H3. contradiction.
Qed.
(* Here is the contradiction : the torn number's index is above a sequence that tends to infinity *)
Lemma limit_index_above_all_indices (u : nat -> R) (v : R -> nat) (en : R_enum u v) :
forall n : nat, v (fst (tearing_sequences u v (S n))) < v (proj1_sig (torn_number u v en)).
Proof.
intros. simpl. destruct (tearing_sequences u v n) eqn:tear.
(* The torn number was not chosen, so its index is above *)
pose proof (tearing_sequences_ordered u v en n). rewrite -> tear in H.
pose proof (first_two_in_interval_works u v r r0 en H).
destruct (first_two_in_interval u v r r0) eqn:ft. simpl.
assert (tearing_sequences u v (S n) = (r1, r2)).
{ simpl. rewrite -> tear. assumption. }
apply H0.
- pose proof (torn_number_above_first_sequence u v en n). rewrite -> tear in H2. assumption.
- pose proof (torn_number_below_second_sequence u v en n). rewrite -> tear in H2. assumption.
- pose proof (torn_number_above_first_sequence u v en (S n)). rewrite -> H1 in H2. simpl in H2.
intro H5. subst. apply Rlt_irrefl in H2. contradiction.
- pose proof (torn_number_below_second_sequence u v en (S n)). rewrite -> H1 in H2. simpl in H2.
intro H5. subst. apply Rlt_irrefl in H2. contradiction.
Qed.
(* The indices increase because each time the minimum index is chosen *)
Lemma first_indices_increasing (u : nat -> R) (v : R -> nat) :
R_enum u v -> forall n : nat, n <> 0 -> v (fst (tearing_sequences u v n))
< v (fst (tearing_sequences u v (S n))).
Proof.
intros. destruct n. contradiction. simpl.
pose proof (tearing_sequences_ordered u v H n).
destruct (tearing_sequences u v n) eqn:tear.
pose proof (first_two_in_interval_works u v r r0 H H1).
destruct (first_two_in_interval u v r r0) eqn:ft. simpl.
destruct H2 as [fth [fth0 [fth1 [fth2 [fth3 fth4]]]]].
pose proof (first_two_in_interval_works u v r1 r2 H fth3).
destruct (first_two_in_interval u v r1 r2) eqn:ft2. simpl.
destruct H2 as [H2 [H3 [H4 [H5 [H6 H7]]]]]. destruct H.
apply fth4.
- apply (Rlt_trans r r1); assumption.
- apply (Rlt_trans r3 r2); assumption.
- intro abs. subst. apply Rlt_irrefl in H2. contradiction.
- intro abs. subst. apply Rlt_irrefl in H3. contradiction.
Qed.
Theorem r_uncountable : forall (u : nat -> R) (v : R -> nat), ~R_enum u v.
Proof.
intros u v H.
assert (forall n : nat, n + v (fst (tearing_sequences u v 1))
<= v (fst (tearing_sequences u v (S n)))).
{ induction n. simpl. apply le_refl.
apply (le_trans (S n + v (fst (tearing_sequences u v 1)))
(S (v (fst (tearing_sequences u v (S n)))))).
simpl. apply le_n_S. assumption.
apply first_indices_increasing. assumption. discriminate. }
assert (v (proj1_sig (torn_number u v H)) + v (fst (tearing_sequences u v 1))
< v (proj1_sig (torn_number u v H))).
{ pose proof (limit_index_above_all_indices u v H (v (proj1_sig (torn_number u v H)))).
specialize (H0 (v (proj1_sig (torn_number u v H)))).
apply (le_lt_trans (v (proj1_sig (torn_number u v H)) + v (fst (tearing_sequences u v 1)))
(v (fst (tearing_sequences u v (S (v (proj1_sig (torn_number u v H)))))))).
assumption. assumption. }
assert (forall n m : nat, ~(n + m < n)).
{ induction n. intros. intro H2. inversion H2. intro m. intro H2. simpl in H2.
apply lt_pred in H2. simpl in H2. apply IHn in H2. contradiction. }
apply H2 in H1. contradiction.
Qed.
In ZFC, the real numbers satisfy two useful properties:
there is a function e : R * R -> bool that returns true if and only if its two arguments are equal, and
the order relation is antisymmetric: if x <= y and y <= x, then x = y.
Both of these properties would fail in Coq if the real numbers were defined without additional axioms in terms of Cauchy sequences or Dedekind cuts. For example, a Dedekind cut can be defined as a pair of predicates P Q : rational -> Prop that satisfy certain properties. It is impossible to write a Coq function that decides whether two cuts are equal, because equality of predicates on rationals is undecidable. And any reasonable notion of ordering on cuts would fail to satisfy antisymmetry because equality on predicates is not extensional: it is not the case that forall x, P x <-> Q x implies P = Q.
As for your second question, it is true that there can be only countably many Coq terms of type R -> Prop. However, the same is true of ZFC: there are only countably many formulas for defining subsets of the real numbers. This is connected to the Löwenheim-Skolem paradox, which implies that if ZFC is consistent it has a countable model -- which, in particular, would have only countably many real numbers. Both in ZFC and in Coq, however, it is impossible to define a function that enumerates all real numbers: they are countable from our own external perspective on the theory, but uncountable from the theory's point of view.
Many think that the current definition of Real numbers in Coq is far from optimal and we are just waiting for someone to produce a better alternative. The choice of axioms introduces many complications [including consistency problems in the past], and a formulation in terms of cuts plus excluded middle would be great to have.
If I am not mistaken the proof of the four color theorem includes such a formalization; also, constructive developments such as CoRN should work as it is usually the case that most theorems of classical analysis can be recovered from their intuitionistic version plus + EM.
With the following definitions I want to prove lemma without_P
Variable n : nat.
Definition mnnat := {m : nat | m < n}.
Variable f : mnnat -> nat.
Lemma without_P : (exists x : mnnat, True) -> (exists x, forall y, f x <= f y).
Lemma without_P means: if you know (the finite) set mnnat is not empty, then there must exist an element in mnnat, that is the smallest of them all, after mapping f onto mnnat.
We know mnnat is finite, as there are n-1 numbers in it and in the context of the proof of without_P we also know mnnat is not empty, because of the premise (exists x : mnnat, True).
Now mnnat being non-empty and finite "naturally/intuitively" has some smallest element (after applying f on all its elements).
At the moment I am stuck at the point below, where I thought to proceed by induction over n, which is not allowed.
1 subgoal
n : nat
f : mnnat -> nat
x : nat
H' : x < n
______________________________________(1/1)
exists (y : nat) (H0 : y < n),
forall (y0 : nat) (H1 : y0 < n),
f (exist (fun m : nat => m < n) y H0) <= f (exist (fun m : nat => m < n) y0 H1)
My only idea here is to assert the existance of a function f' : nat -> nat like this: exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f' (exist (fun m : nat => m < n) x H0) = f x, after solving this assertion I have proven the lemma by induction over n. How can I prove this assertion?
Is there a way to prove "non-empty, finite sets (after applying f to each element) have a minimum" more directly? My current path seems too hard for my Coq-skills.
Require Import Psatz Arith. (* use lia to solve the linear integer arithmetic. *)
Variable f : nat -> nat.
This below is essentially your goal, modulo packing of the statement into some dependent type. (It doesn't say that mi < n, but you can extend the proof statement to also contain that.)
Goal forall n, exists mi, forall i, i < n -> f mi <= f i.
induction n; intros.
- now exists 0; inversion 1. (* n cant be zero *)
- destruct IHn as [mi IHn]. (* get the smallest pos mi, which is < n *)
(* Is f mi still smallest, or is f n the smallest? *)
(* If f mi < f n then mi is the position of the
smallest value, otherwise n is that position,
so consider those two cases. *)
destruct (lt_dec (f mi) (f n));
[ exists mi | exists n];
intros.
+ destruct (eq_nat_dec i n).
subst; lia.
apply IHn; lia.
+ destruct (eq_nat_dec i n).
subst; lia.
apply le_trans with(f mi).
lia.
apply IHn.
lia.
Qed.
Your problem is an specific instance of a more general result which is proven for example in math-comp. There, you even have a notation for denoting "the minimal x such that it meets P", where P must be a decidable predicate.
Without tweaking your statement too much, we get:
From mathcomp Require Import all_ssreflect.
Variable n : nat.
Variable f : 'I_n.+1 -> nat.
Lemma without_P : exists x, forall y, f x <= f y.
Proof.
have/(_ ord0)[] := arg_minP (P:=xpredT) f erefl => i _ P.
by exists i => ?; apply/P.
Qed.
I found a proof to my assertion (exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f (exist (fun m : nat => m < n) x H0) = f' x). by proving the similar assertion (exists (f' : nat -> nat), forall x : mnnat, f x = f' (proj1_sig x)). with Lemma f'exists. The first assertion then follows almost trivially.
After I proved this assertion I can do a similar proof to user larsr, to prove Lemma without_P.
I used the mod-Function to convert any nat to a nat smaller then n, apart from the base case of n = 0.
Lemma mod_mnnat : forall m,
n > 0 -> m mod n < n.
Proof.
intros.
apply PeanoNat.Nat.mod_upper_bound.
intuition.
Qed.
Lemma mod_mnnat' : forall m,
m < n -> m mod n = m.
Proof.
intros.
apply PeanoNat.Nat.mod_small.
auto.
Qed.
Lemma f_proj1_sig : forall x y,
proj1_sig x = proj1_sig y -> f x = f y.
Proof.
intros.
rewrite (sig_eta x).
rewrite (sig_eta y).
destruct x. destruct y as [y H0].
simpl in *.
subst.
assert (l = H0).
apply proof_irrelevance. (* This was tricky to find.
It means two proofs of the same thing are equal themselves.
This makes (exist a b c) (exist a b d) equal,
if c and d prove the same thing. *)
subst.
intuition.
Qed.
(* Main Lemma *)
Lemma f'exists :
exists (ff : nat -> nat), forall x : mnnat, f x = ff (proj1_sig x).
Proof.
assert (n = 0 \/ n > 0).
induction n.
auto.
intuition.
destruct H.
exists (fun m : nat => m).
intuition. destruct x. assert (l' := l). rewrite H in l'. inversion l'.
unfold mnnat in *.
(* I am using the mod-function to map (m : nat) -> {m | m < n} *)
exists (fun m : nat => f (exist (ltn n) (m mod n) (mod_mnnat m H))).
intros.
destruct x.
simpl.
unfold ltn.
assert (l' := l).
apply mod_mnnat' in l'.
assert (proj1_sig (exist (fun m : nat => m < n) x l) = proj1_sig (exist (fun m : nat => m < n) (x mod n) (mod_mnnat x H))).
simpl. rewrite l'.
auto.
apply f_proj1_sig in H0.
auto.
Qed.