Why are the real numbers axiomatized in Coq? - coq

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.

Related

Fail to prove a permutation property

I have created this simple type :
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
and I try to prove this permutation lemma :
Lemma permutImplist :
forall (n a b c:nat) (input:list nat), implist n ((a::b::c::input)) <-> implist n ((c::b::a::input)).
I've tried various induction principles on the type itself or the list, but always end up in a dead end.
Can someone help me with this proof ?
Thanks !!
The induction principle of this predicate is not very useful for proving this directly. It is much better to find an alternative formulation of implist to make your proof go through:
From Coq Require Import List PeanoNat Lia.
Import ListNotations.
Inductive implist : nat -> list nat -> Prop :=
| GSSingle : forall (n:nat), implist n [n]
| GSPairLeft : forall (a b n:nat) (l:list nat), implist n l -> implist n ([a]++[b]++l)
| GSPairRight : forall (a b n:nat) (l:list nat), implist n l -> implist n (l++[a]++[b]).
Lemma implist_alt n l :
implist n l <->
exists l1 l2,
l = l1 ++ n :: l2 /\
Nat.even (length l1) = true /\
Nat.even (length l2) = true.
Proof.
split.
- intros H. induction H as [n|a b n l _ IH|a b n l _ IH].
+ exists [], []; intuition.
+ destruct IH as (l1 & l2 & -> & Hl1 & Hl2).
exists (a :: b :: l1), l2; intuition.
+ destruct IH as (l1 & l2 & -> & Hl1 & Hl2).
exists l1, (l2 ++ [a; b]). simpl.
rewrite <- app_assoc, app_length, Nat.add_comm.
intuition.
- intros (l1 & l2 & -> & Hl1 & Hl2).
assert (Hb1 : exists b, length l1 < b) by (exists (S (length l1)); lia).
destruct Hb1 as (b1 & Hb1).
assert (Hb2 : exists b, length l2 < b) by (exists (S (length l2)); lia).
destruct Hb2 as (b2 & Hb2).
revert l1 b2 l2 Hl1 Hl2 Hb1 Hb2.
induction (Nat.lt_wf_0 b1) as [b1 _ IH1].
intros [| x1 [| y1 l1]]; simpl; try easy.
+ intros b2 l2 _ Hl2 _. revert l2 Hl2.
induction (Nat.lt_wf_0 b2) as [b2 _ IH2].
induction l2 as [|x2 l2 _] using rev_ind.
* intros _ _. apply GSSingle.
* induction l2 as [|y2 l2 _] using rev_ind; simpl; try easy.
rewrite !app_length. simpl. rewrite <- Nat.add_assoc, Nat.add_comm. simpl.
intros Hl2 Hb2. rewrite <- app_assoc.
change (n :: l2 ++ [y2] ++ [x2]) with ((n::l2) ++ [y2] ++ [x2]).
apply GSPairRight. apply (IH2 (S (S (length l2)))); eauto; lia.
+ intros b2 l2 Hl1 Hl2 Hb1 Hb2.
apply (GSPairLeft x1 y1). apply (IH1 (S (S (length l1))) Hb1 _ b2); eauto.
Qed.
Lemma permutImplist_aux :
forall (n a b c:nat) (input:list nat), implist n ((a::b::c::input)) -> implist n ((c::b::a::input)).
Proof.
intros n a b c l (l1 & l2 & e & Hl1 & Hl2)%implist_alt.
destruct l1 as [|x l1]; simpl in *.
{ injection e as <- <-; simpl in *.
apply implist_alt. exists [c; b], l; intuition. }
destruct l1 as [|y l1]; simpl in *; try easy.
injection e as <- <- e.
destruct l1 as [|z l1]; simpl in *.
{ injection e as <- <-.
apply implist_alt. exists [], (b :: a :: l); intuition. }
destruct l1 as [|w l1]; simpl in *; try easy.
injection e as <- ->.
apply implist_alt. exists (c :: b :: a :: w :: l1), l2.
intuition.
Qed.
Lemma permutImplist :
forall (n a b c:nat) (input:list nat), implist n ((a::b::c::input)) <-> implist n ((c::b::a::input)).
Proof.
intros n a b c l; split; apply permutImplist_aux.
Qed.
The tricky part, as you can see, is the reverse direction of implist_alt. The ideal way of proving this would be to have an induction principle for lists of even length. Since we do not have this, I have instead used strong induction on the length of the even lists, which works fine as well.
Following the advice about the induction principal for even lists, I've been able to produce a shorter proof for the reverse direction part :
Lemma implist_alt' :
forall (n:nat) (l:list nat), implist n l <-> exists l1 l2, l = l1 ++ n::l2 /\ Nat.Even (length l1) /\ Nat.Even (length l2).
Proof.
split.
- intros H. induction H as [n|a b n l _ IH|a b n l _ IH].
+ exists [], []; intuition; simpl; now exists 0.
+ destruct IH as (l1 & l2 & -> & Hl1 & Hl2).
exists (a :: b :: l1), l2. intuition. simpl. now rewrite Nat.Even_succ_succ.
+ destruct IH as (l1 & l2 & -> & Hl1 & Hl2).
exists l1, (l2 ++ [a; b]). simpl.
rewrite <- app_assoc, app_length, Nat.add_comm.
intuition. simpl. now rewrite Nat.Even_succ_succ.
- intros (l1 & l2 & -> & Hl1 & Hl2).
induction l1 using list_pair_induction.
simpl. now apply (EvenImplist n l2).
simpl in Hl1. rewrite Nat.Even_succ_succ in Hl1. apply IHl1 in Hl1. revert Hl1. now apply (GSPairLeft a b n (l1++n::l2)).
simpl in Hl1. exfalso. now apply Even_1.
Qed.
It uses the following induction principal on lists :
Section list_pair_induction.
Variable P : list nat -> Prop.
Hypothesis Hnil : P nil.
Hypothesis Hddn : forall (l:list nat) (a b:nat) , P l -> P (a::b::l).
Theorem allEven : forall (xs:list nat), even (length xs) = true -> P xs.
Proof.
intro.
remember (length xs) as n eqn : Heqn.
revert n xs Heqn.
induction n as [n IH] using (well_founded_induction lt_wf).
destruct n as [|n].
now destruct xs.
destruct n as [|n].
intros; discriminate.
destruct xs as [|a xs].
intros; discriminate.
destruct xs as [|b xs].
intros; discriminate.
simpl.
intros H1 H2.
apply Hddn.
apply IH with (y := n); auto.
now injection H1.
Qed.
Theorem allEven' : forall (xs:list nat), Nat.Even (length xs) -> P xs.
Proof.
intro.
rewrite <- Nat.even_spec.
apply allEven.
Qed.
Hypothesis Hsingle : forall (n:nat), P (n::nil).
Theorem Hsingle2Hsing : (forall n:nat, P(n::nil) ) -> forall (xs:list nat), (1 = length xs) -> P xs.
Proof.
induction xs.
intro.
exfalso.
simpl in H0.
congruence.
induction xs.
intro.
apply Hsingle.
intro.
exfalso.
simpl in H0.
congruence.
Qed.
Theorem allOdd : forall (xs:list nat), odd (length xs) = true -> P xs.
Proof.
intro.
remember (length xs) as n eqn : Heqn.
revert n xs Heqn.
induction n as [n IH] using (well_founded_induction lt_wf).
destruct n as [|n].
now destruct xs.
destruct n as [|n].
intros.
generalize Heqn.
generalize xs.
generalize Hsingle.
apply Hsingle2Hsing.
destruct xs as [|a xs].
intros; discriminate.
destruct xs as [|b xs].
intros; discriminate.
simpl.
intros H1 H2.
apply Hddn.
apply IH with (y := n); auto.
now injection H1.
Qed.
Hypothesis Hsing : forall (l:list nat) , (1 = length l) -> P (l).
Theorem allOddsing : forall (xs:list nat), odd (length xs) = true -> P xs.
Proof.
intro.
remember (length xs) as n eqn : Heqn.
revert n xs Heqn.
induction n as [n IH] using (well_founded_induction lt_wf).
destruct n as [|n].
now destruct xs.
destruct n as [|n].
intros.
apply Hsing.
assumption.
destruct xs as [|a xs].
intros; discriminate.
destruct xs as [|b xs].
intros; discriminate.
simpl.
intros H1 H2.
apply Hddn.
apply IH with (y := n); auto.
now injection H1.
Qed.
Theorem allOdd' : forall (xs:list nat), Nat.Odd (length xs) -> P xs.
Proof.
intro.
rewrite <- Nat.odd_spec.
apply allOdd.
Qed.
Theorem list_pair_induction : forall (xs:list nat), P xs.
Proof.
intro.
remember (length xs) as n eqn : Heqn.
destruct even_odd_dec with n.
apply allEven'.
rewrite <- Heqn.
assumption.
apply allOdd'.
rewrite <- Heqn.
assumption.
Qed.
End list_pair_induction.

What does the tactic destruct do in the proof below?

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.

How to do induction differently?

I am doing an exercise in Coq and trying to prove if a list equals to its reverse, it's a palindrome. Here is how I define palindromes:
Inductive pal {X : Type} : list X -> Prop :=
| emptypal : pal []
| singlpal : forall x, pal [x]
| inducpal : forall x l, pal l -> pal (x :: l ++ [x]).
Here is the theorem:
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.
According to my definition, I will need to do the induction my extracting the front and tail element but apparently coq won't let me do it, and if I force it to do so, it gives an induction result that definitely doesn't make any sense:
Proof.
intros X l H. remember (rev l) as rl. induction l, rl.
- apply emptypal.
- inversion H.
- inversion H.
- (* stuck *)
context:
1 subgoals
X : Type
x : X
l : list X
x0 : X
rl : list X
Heqrl : x0 :: rl = rev (x :: l)
H : x :: l = x0 :: rl
IHl : x0 :: rl = rev l -> l = x0 :: rl -> pal l
______________________________________(1/1)
pal (x :: l)
aparently the inductive context is terribly wrong. is there any way I can fix the induction?
The solution I propose here is probably not the shortest one, but I think it is rather natural.
My solution consists in defining an induction principle on list specialized to your problem.
Consider natural numbers. There is not only the standard induction nat_ind where you prove P 0 and forall n, P n -> P (S n). But there are other induction schemes, e.g., the strong induction lt_wf_ind, or the two-step induction where you prove P 0, P 1 and forall n, P n -> P (S (S n)). If the standard induction scheme is not strong enough to prove the property you want, you can try another one.
We can do the same for lists. If the standard induction scheme list_ind is not enough, we can write another one that works. In this idea, we define for lists an induction principle similar to the two-step induction on nat (and we will prove the validity of this induction scheme using the two-step induction on nat), where we need to prove three cases: P [], forall x, P [x] and forall x l x', P l -> P (x :: l ++ [x']). The proof of this scheme is the difficult part. Applying it to deduce your theorem is quite straightforward.
I don't know if the two-step induction scheme is part of the standard library, so I introduce it as an axiom.
Axiom nat_ind2 : forall P : nat -> Prop, P 0 -> P 1 ->
(forall n : nat, P n -> P (S (S n))) -> forall n : nat, P n.
Then we prove the induction scheme we want.
Lemma list_ind2 : forall {A} (P : list A -> Prop) (P_nil : P [])
(P_single : forall x, P [x])
(P_cons_snoc : forall x l x', P l -> P (x :: l ++ [x'])),
forall l, P l.
Proof.
intros. remember (length l) as n. symmetry in Heqn. revert dependent l.
induction n using nat_ind2; intros.
- apply length_zero_iff_nil in Heqn. subst l. apply P_nil.
- destruct l; [discriminate|]. simpl in Heqn. inversion Heqn; subst.
apply length_zero_iff_nil in H0. subst l. apply P_single.
- destruct l; [discriminate|]. simpl in Heqn.
inversion Heqn; subst. pose proof (rev_involutive l) as Hinv.
destruct (rev l). destruct l; discriminate. simpl in Hinv. subst l.
rewrite app_length in H0.
rewrite PeanoNat.Nat.add_comm in H0. simpl in H0. inversion H0.
apply P_cons_snoc. apply IHn. assumption.
Qed.
You should be able to conclude quite easily using this induction principle.
Theorem palindrome3 : forall {X : Type} (l : list X),
l = rev l -> pal l.

How do you determine which terms to call intros on in coq

I am a beginner with coq, so this may be a trivial question. Sometimes I can't figure out which terms I need to call intros on, when writing a Theorem. A simple example,
Theorem silly1 : forall (n m o p : nat),
n = m ->
[n;o] = [n;p] ->
[n;o] = [m;p].
Proof.
intros n m o p eq1 eq2.
rewrite <- eq1.
apply eq2. Qed.
I know based on the goal, that I will probably need to call intros on (n m o p), but why do I need to use it on eq1 and eq2.
Also, in some other Theorems, you may need to use intros on the type parameter, the hypothesis, or the inductive hypothesis. Example
Theorem trans_eq : forall (X:Type) (n m o : X),
n = m -> m = o -> n = o.
Proof.
intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
reflexivity. Qed.
Theorem silly3' : forall (n : nat),
(beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
true = beq_nat n 5 ->
true = beq_nat (S (S n)) 7.
Proof.
intros n eq H.
symmetry in H. apply eq in H. symmetry in H.
apply H. Qed.
So I guess what I'm asking is...when I start proving a theorem, how should I go about reasoning through the goals, to determine which terms I need to call intros on?
An example of what gallais is refering to is this.
Theorem example_1 : forall A B, (A -> B) -> A -> B.
Proof. intros ? ? H1. apply H1. Qed.
Theorem example_2 : forall A B, (A -> B) -> A -> B.
Proof. intros ? ? H1 H2. apply H1. apply H2. Qed.
Print example_1.
Print example_2.
Another example of when it can be problematic is using introduction before using induction. This makes the induction hypothesis different.
Fixpoint reverse_helper {A : Type} (l1 l2 : list A) : list A :=
match l1 with
| nil => l2
| cons x l1 => reverse_helper l1 (cons x l2)
end.
Theorem example_3 : forall A (l1 l2 : list A), reverse_helper l1 l2 = app (reverse_helper l1 nil) l2.
Proof. intros. induction l1. simpl. reflexivity. simpl. try rewrite IHl1. Abort.
Theorem example_4 : forall A (l1 l2 : list A), reverse_helper l1 l2 = app (reverse_helper l1 nil) l2.
Proof. induction l1. intros. simpl. reflexivity. intros. simpl. rewrite (IHl1 (cons a l2)). rewrite (IHl1 (cons a nil)). Admitted.
Otherwise, you should use introduction whenever you can. You won't be able to use whatever is being quantified over or the antecedents of an implication until you do.
By the way
H1 : A1
...
Hn : An
___
B
is equivalent to
H1: A1, ..., Hn: An ⊢ B.
When you prove something interactively, you're using a sequent calculus starting from the conclusion and working your way back to the hypotheses.

Coq: Problems with List In inductive

I'm new to Coq, but with some effort I was able to prove various inductive lemmas. However I get stuck on all exercises that uses the following inductive definition:
Inductive In (A:Type) (y:A) : list A -> Prop :=
| InHead : forall xs:list A, In y (cons y xs)
| InTail : forall (x:A) (xs:list A), In y xs -> In y (cons x xs).
The furthest i got was with the following lemma:
Lemma my_In_rev : forall (A:Type) (x:A) (l:list A), In x l -> In x (rev l).
Proof.
induction l.
simpl.
trivial.
simpl.
intros.
The following two lemmas I cant get past the first steps, because I get stuck on the exists goal right after using intros.
Lemma my_In_map : forall (A B:Type) (y:B) (f:A->B) (l:list A), In y (map f l) -> exists x : A, In x l /\ y = f x.
Lemma my_In_split : forall (A:Type) (x:A) (l : list A), In x l -> exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
Any help would be appreciated!
For your first lemma, I added two simple sublemmas (that you can find in the list library).
The two others are more straightforward.
Require Import List.
Lemma In_concat_l: forall (A: Type) (l1 l2: list A) (x:A),
In x l1 -> In x (l1 ++ l2).
Proof.
intros A.
induction l1 as [ | hd tl hi ]; intros l2 x hIn; simpl in *.
- contradiction.
- destruct hIn.
+ left; assumption.
+ right; now apply hi.
Qed.
Lemma In_concat_r: forall (A: Type) (l1 l2: list A) (x:A),
In x l2 -> In x (l1 ++ l2).
intros A.
induction l1 as [ | hd tl hi ]; intros l2 x hIn; simpl in *.
- assumption.
- right; now apply hi.
Qed.
Lemma my_In_rev : forall (A:Type) (x:A) (l:list A), In x l -> In x (rev l).
Proof.
intros A x l.
induction l as [ | hd tl hi ]; intros hIn; simpl in *.
- contradiction.
- destruct hIn.
+ apply In_concat_r.
rewrite H.
now constructor.
+ apply In_concat_l.
now apply hi.
Qed.
Lemma my_In_map : forall (A B:Type) (y:B) (f:A->B) (l:list A), In y (map f l) -> exists x : A, In x l /\ y = f x.
Proof.
intros A B y f l.
induction l as [ | hd tl hi]; intros hIn; simpl in *.
- contradiction.
- destruct hIn.
+ exists hd; split.
left; reflexivity.
symmetry; assumption.
+ destruct (hi H) as [x0 [ h1 h2]].
exists x0; split.
right; assumption.
assumption.
Qed.
Lemma my_In_split : forall (A:Type) (x:A) (l : list A), In x l -> exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
intros A x l.
induction l as [ | hd tl hi]; intros hIn; simpl in *.
- contradiction.
- destruct hIn.
rewrite H.
exists nil; exists tl; simpl; reflexivity.
destruct (hi H) as [ l1 [ l2 h ]].
exists (hd :: l1); exists l2.
rewrite <- app_comm_cons; rewrite h.
reflexivity.
Qed.
I won't say it's less complex than Rui's answer, but I find this solution a little bit easier to understand. But in the end, they are relatively close.
Cheers,
V.
When the goal is existentially quantified, you have to give a concrete example of an object with the stated property, and when a hypothesis is existentially quantified, you're allowed to assume one such object exists and introduce it. See FAQs 47, 53, and 54. By the way, an In predicate is already defined in Coq.Lists.List. Check it out here. A reference for Coq tactics is here.
A proof of the first lemma:
Require Import Coq.Lists.List.
Require Import Coq.Setoids.Setoid.
Inductive In {A : Type} (y : A) : list A -> Prop :=
| InHead : forall xs : list A, In y (cons y xs)
| InTail : forall (x : A) (xs : list A), In y xs -> In y (cons x xs).
Lemma L1 : forall (t1 : Type) (l1 : list t1) (o1 o2 : t1),
In o1 (o2 :: l1) <-> o1 = o2 \/ In o1 l1.
Proof.
intros t1 l1 o1 o2. split.
intros H1. inversion H1 as [l2 [H3 H4] | o3 l2 H2 [H3 H4]].
left. reflexivity.
right. apply H2.
intros H1. inversion H1 as [H2 | H2].
rewrite H2. apply InHead.
apply InTail. apply H2.
Qed.
Lemma my_In_map : forall (A B : Type) (l : list A) (y : B) (f : A -> B),
In y (map f l) -> exists x : A, In x l /\ y = f x.
Proof.
intros A B. induction l as [| z l H1].
intros y f H2. simpl in *. inversion H2.
intros y f H2. simpl in *. rewrite L1 in H2. inversion H2 as [H3 | H3].
exists z. split.
apply InHead.
apply H3.
assert (H4 := H1 _ _ H3). inversion H4 as [x [H5 H6]]. exists x. split.
rewrite L1. right. apply H5.
apply H6.
Qed.