I have a definition of conat which can represent both finite and infinite values, a conversion from nat, a definition of infinity, and a bisimulation relation:
CoInductive conat : Set := O' | S' (n : conat).
Fixpoint toCo (n : nat) : conat := match n with
| O => O'
| S n' => S' (toCo n') end.
CoFixpoint inf : conat := S' inf.
CoInductive bisim : conat -> conat -> Prop :=
| OO : bisim O' O'
| SS : forall n m : conat, bisim n m -> bisim (S' n) (S' m).
Notation "x == y" := (bisim x y) (at level 70).
I want to prove that conat is either finite or infinite (I'm not 100% sure that this is the correct formulation):
(* This is the goal *)
Theorem fin_or_inf : forall n : conat, (exists m : nat, toCo m == n) \/ (n == inf).
I couldn't prove it so far, but I could prove another statement that, if a conat is not finite, it is infinite (again, not 100% sure about the formulation):
(* I have a proof for this *)
Theorem not_fin_then_inf : forall n : conat, ~ (exists m : nat, toCo m == n) -> (n == inf).
I have no idea how to go from not_fin_then_inf to fin_or_inf though.
Is my definition of fin_or_inf correct?
Can I prove fin_or_inf, either using not_fin_then_inf or not using it?
Also, I found that bridging the gap between the two theorems involves decidability of bisimulation (or extension thereof). I think the decidability theorem could be stated as
Lemma bisim_dec : forall n m : conat, n == m \/ ~ (n == m).
Can I prove bisim_dec or any similar statement on bisimulation?
Edit
The original motivation to prove "either finite or infinite" was to prove commutativity and associativity of coplus:
CoFixpoint coplus (n m : conat) := match n with
| O' => m
| S' n' => S' (coplus n' m)
end.
Notation "x ~+ y" := (coplus x y) (at level 50, left associativity).
Theorem coplus_comm : forall n m, n ~+ m == m ~+ n.
Theorem coplus_assoc : forall n m p, n ~+ m ~+ p == n ~+ (m ~+ p).
Going through the same way as nat's + does not work because it requires transitivity of == with a lemma analogous to plus_n_Sm, which makes the cofix call unguarded. Otherwise, I have to destruct both n and m, and then I'm stuck at the goal n ~+ S' m == m ~+ S' n.
If I choose an alternative definition of coplus:
CoFixpoint coplus (n m : conat) := match n, m with
| O', O' => O'
| O', S' m' => S' m'
| S' n', O' => S' n'
| S' n', S' m' => S' (S' (coplus n' m'))
end.
Then coplus_comm is easy, but coplus_assoc becomes near-impossible to prove instead.
Can I indeed prove coplus_comm with the first definition of coplus, or coplus_assoc with the second?
Related
Yesterday I asked a question here about a proof in Coq and the answer helped me a lot, I was able to solve many exercises alone and discover new features. Today I have another exercise, which states that For all m, n, if m <= n then max(m,n) = n. I tried to do induction after m, but I got stuck. Any help would be appreciated!
Fixpoint max (m n : Nat) : Nat :=
match m with
| O => n
| S m' => match n with
| O => m
| S n' => S (max m' n')
end
end.
Fixpoint le_Nat (m n : Nat) : bool :=
match m with
| O => true
| S m' => match n with
| O => false
| S n' => (le_Nat m' n')
end
end.
Lemma:
Lemma le_max_true :
forall m n,
le_Nat m n = true ->
max m n = n.
Proof.
...
Qed.
Let's consider the 4th sub-goal.
1 goal (ID 39)
m : nat
IHm : forall n : nat, le_nat m n = true -> max m n = n
n : nat
============================
le_nat m n = true -> S (max m n) = S n
rewrite IHm is able to replace (max m N) with N(for any N), under the condition le_nat m N = true.
By an intro H, you push an hypothesis of type le_nat m n = true into the context. Then your rewrite IHm generates two (trivial) sub-goals.
In short, in order to solve the 4th sub-goal, you may start with intro H; rewrite IHm.
If you forget the intro H, you get an unsolvable goal:
m : Nat
IHm : forall n : Nat, le_Nat m n = true -> max m n = n
n : Nat
============================
le_Nat m n = true
You need to do induction on both m and n (m and then n). After that, the goal is relatively straightforward.
I want to show the following:
match H in (_ = y) return y with
| eq_refl => exist (fun n' : nat => n' < n) x0 l
end = exist (fun n' : nat => n' < n) x0 l
I have in my context:
H : ltn n = ltn n
n : nat
x0 : nat
l : x0 < n
Where
Definition ltn (n : nat) : Type := {n' | n' < n}.
I'm unable to destruct on H, because the resulting term would be ill-typed, but it seems clear the equality holds because the only possible branch from match does not depend on what's being matched.
The problem (as you said) is that Coq cannot destruct H, once it's a variable without "matchings" and the definition equality (that you are using) is based on normalization and string verification, you will not able to operate this. Anyway, without axioms, you can not destruct an equality instance, given that you are implying that all equalities are equals (definitional equals). The implication of considering all equalities as "equals" assumes that your core is extensionally typed. For the sake of compatibility with others type theories (like homotopy type theory), Coq doesn't allow you to mention UIP without as axiom. UIP axiom and K axiom are very related. You can just export the axioms from Coq standard library.
Theorem exact_eq : forall (n' n x0 : nat) (l : x0 < n) (H : {n' | n' < n} = {n' | n' < n}),
match H in (_ = y) return y with
| eq_refl => exist (fun n' : nat => n' < n) x0 l
end = exist (fun n' : nat => n' < n) x0 l.
intros.
(*UIP_refl : forall (H : x = x), H = erefl x*)
by set(#UIP_refl _ _ H); subst.
Qed.
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.
I have to admit that I'm not very good at coinduction. I'm trying to show a bisimulation principle on co-natural numbers, but I'm stuck on a pair of (symmetric) cases.
CoInductive conat :=
| cozero : conat
| cosucc : conat -> conat.
CoInductive conat_eq : conat -> conat -> Prop :=
| eqbase : conat_eq cozero cozero
| eqstep : forall m n, conat_eq m n -> conat_eq (cosucc m) (cosucc n).
Section conat_eq_coind.
Variable R : conat -> conat -> Prop.
Hypothesis H1 : R cozero cozero.
Hypothesis H2 : forall (m n : conat), R (cosucc m) (cosucc n) -> R m n.
Theorem conat_eq_coind : forall m n : conat,
R m n -> conat_eq m n.
Proof.
cofix. intros m n H.
destruct m, n.
simpl in H1.
- exact eqbase.
- admit.
- admit.
- specialize (H2 H).
specialize (conat_eq_coind _ _ H2).
exact (eqstep conat_eq_coind).
Admitted.
End conat_eq_coind.
This is what the context looks like when focused on the first admitted case:
1 subgoal
R : conat -> conat -> Prop
H1 : R cozero cozero
H2 : forall m n : conat, R (cosucc m) (cosucc n) -> R m n
conat_eq_coind : forall m n : conat, R m n -> conat_eq m n
n : conat
H : R cozero (cosucc n)
______________________________________(1/1)
conat_eq cozero (cosucc n)
Thoughts?
I do not understand what you try to prove here. This is wrong. Take the trivial predicate that is always True for example.
Theorem conat_eq_coind_false :
~ forall (R : conat -> conat -> Prop) (H1 : R cozero cozero)
(H2 : forall (m n : conat), R (cosucc m) (cosucc n) -> R m n)
(m n : conat) (H3 : R m n), conat_eq m n.
Proof.
intros contra.
specialize (contra (fun _ _ => True) I (fun _ _ _ => I)
cozero (cosucc cozero) I).
inversion contra.
Qed.
Assume the following:
Inductive bin : Set := Z | O.
Fixpoint fib (n : nat) : list bin :=
match n with
| 0 => [Z]
| S k => match k with
| 0 => [O]
| S k' => fib k' ++ fib k
end
end.
I would like to show:
Theorem fib_first : forall n,
Nat.Even n -> n > 3 -> exists w, fib n = Z :: w.
However, by performing induction on n, I get a really useless inductive
hypothesis fixing n, stating that IH : Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w.
What I would ideally have is the following: IH : forall n : nat, Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w. Naturally I cannot assume the original proposition, but it feels like I need to prove something stronger perhaps?
My idea for the inductive reasoning would be made possible by expanding F n = F n-2 . F n-1, we know F n-2 is even iff F n is even, and since neither of F n-2 or F n-1 is empty, we can show the substring is shorter, therefore sufficient for the inductive hypothesis - how does one express this in Coq?
The trick is to unfold the definition of Nat.Even and do induction on n / 2 instead of n:
Theorem fib_first : forall n,
Nat.Even n -> exists w, fib n = Z :: w.
Proof.
intros n [m ->].
induction m as [|m IH].
- now exists nil.
- rewrite <- mult_n_Sm, plus_comm.
generalize (2 * m) IH. clear m IH. simpl.
intros n [w ->].
simpl. eauto.
Qed.
Note that your n > 3 hypothesis is not actually needed.