As an exercise I want to prove that there is always exists a maximum element in a non-empty sequence.
Theorem largest_el_in_list (s: seq rat) x : x \in s -> exists y, y \in s /\ forall z, z \in s -> y >= z.
My idea was to go by induction on s, and then to destruct x. The largest element in this first case is the only element in the list. However, in the second case I'm getting quite confused. Am I supposed to use the inductive hypothesis? My idea was that we can get rid of the existential by exists max a a1, where a is the maximal element we found in the previous step, and a1 is the new element being added to the sequence. But if I do this, then I can't use the inductive hypothesis and I get completely stuck.
I've been stuck for hours and would love to know if I have the right idea.
Edit:
Here is the proof so far, with the current proof state below:
Theorem largest_el_in_list (s: seq rat) x : x \in s -> exists y, y \in s /\ forall z, z \in s -> y >= z.
Proof.
elim/last_ind : s => //= s x0 IH x_in_rcons.
case : s IH x_in_rcons.
move => _ x_in_sx0.
exists x0. split.
rewrite in_cons. apply/orP. left. by apply/eqP.
rewrite in_cons in x_in_sx0. case/orP : x_in_sx0 => //= xeqx0 z z_in_sx0.
rewrite in_cons in z_in_sx0. case/orP : z_in_sx0 => //= zeqx0. case/eqP : zeqx0 => zeqx0.
by rewrite zeqx0.
move => a l IH x_in_rcons.
exists (maxr x0 a). split.
have [agex0 | x0gta] := (lerP x0 a).
by rewrite mem_head.
rewrite rcons_cons in_cons. apply/orP. right. by rewrite in_rcons.
move => z z_in_rcons.
Admitted.
Proof state:
x: rat_eqType
x0, a: rat
l: seq rat
IH: x \in a :: l ->
exists y : rat, y \in a :: l /\ (forall z : rat, z \in a :: l -> z <= y)
x_in_rcons: x \in rcons (a :: l) x0
z: rat
z_in_rcons: z \in rcons (a :: l) x0
-------------------------------
(1/1)
z <= maxr x0 a
ANOTHER EDIT:
Imports:
From finprob Require Import prob.
From mathcomp Require Import all_ssreflect all_algebra seq.
From extructures Require Import ord fset fmap ffun.
Import Num.Theory.
Import GRing.
Import Bool.
Import Num.Def.
You can find extructures here https://github.com/arthuraa/extructures
And finprob here https://github.com/arthuraa/finprob
UPDATE:
Although changing the definition clears the path, there is still an issue. Here is the updated proof and proof state:
Theorem largest_el_in_list (s: seq rat) : s != [::] -> exists y, y \in s /\ forall z, z \in s -> y >= z.
Proof.
elim/last_ind : s => //= s x0 IH x_in_rcons.
case : s IH x_in_rcons.
move => _ x_in_sx0.
exists x0. split.
rewrite in_cons. apply/orP. left. by apply/eqP.
move => z z_in_cons.
rewrite in_cons in z_in_cons.
case/orP : z_in_cons => //= zeqx0.
case/eqP : zeqx0 => zeqx0. by rewrite zeqx0.
move => a l IH cons_nempty.
case IH => //= x [x_in_cons IH'].
exists x.
split.
rewrite in_cons in x_in_cons.
rewrite in_cons.
case/orP : x_in_cons => [xeqa | x_in_l].
by rewrite xeqa orTb. apply/orP. right. rewrite in_rcons. apply/orP. by right.
move => z z_in_cons.
apply IH'.
rewrite in_cons. rewrite in_cons in z_in_cons.
case/orP : z_in_cons => [zeqa | z_in_cons].
by rewrite zeqa orTb.
Admitted.
x0, a: rat
l: seq rat
IH: a :: l != [::] ->
exists y : rat, y \in a :: l /\ (forall z : rat, z \in a :: l -> z <= y)
cons_nempty: rcons (a :: l) x0 != [::]
x: rat
x_in_cons: x \in a :: l
IH': forall z : rat, z \in a :: l -> z <= x
z: rat
z_in_cons: z \in rcons l x0
-------------------------
(1/1)
(z == a) || (z \in l)
I don't see how this can be true, because we know from z_in_cons that z is either equal to x0, or it is in l. Thus, if we go by cases, the first case is impossible because we are lacking some information about x0.
Another approach would be to explicitly provide, right from the start, a value for y, the existence of which you are looking for. This should be the maximum of the list, which you could either specify yourself, via a Fixpoint definition, or be the maximum as defined in Coq.
But if you want to keep the proof by induction, as you suggest in your comment, here is one way (I suppose one can write it in a more concise manner). I'm using here nat instead of rat, for convenience:
Theorem largest_el_in_list (s: seq nat) :
s != [::] -> exists y, y \in s /\ forall z, z \in s -> y >= z.
Proof.
elim: s => [//=|n s IH _].
have [/eqP ->|/IH [max [maxins ismax]]] := boolP (s == nil).
- exists n.
split=> [|y]; first by rewrite in_cons eq_refl orTb.
by rewrite in_cons ?in_nil => /orP [/eqP ->|].
- have [lenx|] := boolP (n <= max).
- exists max.
split=> [|z]; first by rewrite in_cons maxins orbT.
by rewrite in_cons => /orP [/eqP ->|/ismax].
- rewrite -ltnNge.
exists n.
split=> [|z]; first by rewrite in_cons eq_refl orTb.
rewrite in_cons => /orP [/eqP -> //|/ismax ltzx].
by rewrite (#leq_trans max) // ltnW.
Qed.
May be the issue comes from the variable x.
A possible fix is to have x universally quantified, e.g. by starting the proof with a move: x (before the induction on s).
Another solution would be to remove x, which occurs only once in your statement and makes the subgoals hard to read, and prove instead:
Theorem largest_el_in_list (s: seq rat) : s <> nil ->
exists y, y \in s /\ forall z, z \in s -> y >= z.
Related
A common kind of proof I have to make is something like
Lemma my_lemma : forall y, (forall x x', Q x x' y) -> (forall x x', P x y <-> P x' y).
Proof.
intros y Q_y.
split.
+ <some proof using Q>
+ <the same proof using Q, but x and x' are swapped>
where Q is itself some kind of iff-shaped predicate.
My problem is that the proofs of P x y -> P x' y and P x' y -> P x y are often basically identical, with the only difference between that the roles of x and x' are swapped between them. Can I ask Coq to transform the goal into
forall x x', P x y -> P x' y
which then generalises to the iff case, so that I don't need to repeat myself in the proof?
I had a look through the standard library, the tactic index, and some SO questions, but nothing told me how to do this.
Here is a custom tactic for it:
Ltac sufficient_if :=
match goal with
| [ |- forall (x : ?t) (x' : ?t'), ?T <-> ?U ] => (* If the goal looks like an equivalence (T <-> U) (hoping that T and U are sufficiently similar)... *)
assert (HHH : forall (x : t) (x' : t'), T -> U); (* Change the goal to (T -> U) *)
[ | split; apply HHH ] (* And prove the two directions of the old goal *)
end.
Parameter Q : nat -> nat -> nat -> Prop.
Parameter P : nat -> nat -> Prop.
Lemma my_lemma : forall y, (forall x x', Q x x' y) -> (forall x x', P x y <-> P x' y).
Proof.
intros y Q_y.
sufficient_if.
In mathematics, one often can make "assumptions" "without loss of generality" (WLOG) to simplify proofs of this kind. In your example, you could say "assume without loss of generality that P x y holds. To prove P x y <-> P x' y it is sufficient to prove P x' y."
If you are using ssreflect, you have the wlog tactic.
You essentially cut in another goal which can easily solve your goal. You can also do it with standard tactics like assert or enough (which is like assert but the proof obligations are in the other order).
An example to show what I mean: below I just want to show the implication in one direction, because it can easily solve the implication in the other direction (with firstorder).
Context (T:Type) (P:T->T->Prop).
Goal forall x y, P x y <-> P y x.
enough (forall x y, P x y -> P y x) by firstorder.
Now I just have to show the goal in one direction, because it implies the real goal's both directions.
For more about WLOG see for instance 1
I am trying to implement/specify the permutation groups (symmetric groups) in coq. This went well for a bit, until I tried to prove that the identity is actually the identity. My proof gets stuck on proving that the proposition "x is invertible" is exactly the same as the proposition "id * x is invertible".
Are these two propositions actually the same? Am I trying to prove something that is not true? Is there a better way of specifying the permutation group (as a type)?
(* The permutation group on X contains all functions between X and X that are bijective/invertible *)
Inductive G {X : Type} : Type :=
| function (f: X -> X) (H: exists g: X -> X, forall x : X, f (g x) = x /\ g (f x) = x).
(* Composing two functions preserves invertibility *)
Lemma invertible_composition {X : Type} (f g: X -> X) :
(exists f' : X -> X, forall x : X, f (f' x) = x /\ f' (f x) = x) ->
(exists g' : X -> X, forall x : X, g (g' x) = x /\ g' (g x) = x) ->
exists h : X -> X, forall x : X, (fun x => f (g x)) (h x) = x /\ h ((fun x => f (g x)) x) = x.
Admitted.
(* The group operation is composition *)
Definition op {X : Type} (a b : G) : G :=
match a, b with
| function f H, function g H' => function (fun x => f (g x)) (#invertible_composition X f g H H')
end.
Definition id' {X : Type} (x : X) : X := x.
(* The identity function is invertible *)
Lemma id_invertible {X : Type} : exists g : X -> X, forall x : X, id' (g x) = x /\ g (id' x) = x.
Admitted.
Definition id {X : Type} : (#G X) := function id' id_invertible.
(* The part on which I get stuck: proving that composition with the identity does not change elements. *)
Lemma identity {X: Type} : forall x : G, op id x = x /\ #op X x id = x.
Proof.
intros.
split.
- destruct x.
simpl.
apply f_equal.
Abort.
I believe that your statement cannot be proved without assuming extra axioms:
proof_irrelevance:
forall (P : Prop) (p q : P), p = q.
You need this axiom to show that two elements of G are equal when the underlying functions are:
Require Import Coq.Logic.ProofIrrelevance.
Inductive G X : Type :=
| function (f: X -> X) (H: exists g: X -> X, forall x : X, f (g x) = x /\ g (f x) = x).
Arguments function {X} _ _.
Definition fun_of_G {X} (f : G X) : X -> X :=
match f with function f _ => f end.
Lemma fun_of_G_inj {X} (f g : G X) : fun_of_G f = fun_of_G g -> f = g.
Proof.
destruct f as [f fP], g as [g gP].
simpl.
intros e.
destruct e.
f_equal.
apply proof_irrelevance.
Qed.
(As a side note, it is usually better to declare the X parameter of G explicitly, rather than implicitly. It is rarely the case that Coq can figure out what X should be on its own.)
With fun_of_G_inj, it should be possible to show identity simply by applying it to each equality, because fun a => (fun x => x) (g a) is equal to g for any g.
If you want to use this representation for groups, you'll probably also need the axiom of functional extensionality eventually:
functional_extensionality:
forall X Y (f g : X -> Y), (forall x, f x = g x) -> f = g.
This axiom is available in the Coq.Logic.FunctionalExtensionality module.
If you want to define the inverse element as a function, you probably also need some form of the axiom of choice: it is necessary for extracting the inverse element g from the existence proof.
If you don't want to assume extra axioms, you have to place restrictions on your permutation group. For instance, you can restrict your attention to elements with finite support -- that is, permutation that fix all elements of X, except for a finite set. There are multiple libraries that allow you to work with permutations this way, including my own extensional structures.
My question relates to how to construct an exist term in the set of conditions/hypotheses.
I have the following intermediate proof state:
X : Type
P : X -> Prop
H : (exists x : X, P x -> False) -> False
x : X
H0 : P x -> False
______________________________________(1/1)
P x
In my mind, I know that because of H0, x is a witness for (exists x : X, P x -> False), and I want to introduce a name:
w: (exists x : X, P x -> False)
based on the above reasoning and then use it with apply H in w to generate a False in the hypothesis, and finally inversion the False.
But I don't know what tactic/syntax to use to introduce the witness w above. The best I can reach so far is that Check (ex_intro _ (fun x => P x -> False) x H0)). gives False.
Can someone explain how to introduce the existential condition, or an alternative way to finish the proof?
Thanks.
P.S. What I have for the whole theorem to prove is:
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
unfold excluded_middle. unfold not.
intros exm X P H x.
destruct (exm (P x)).
apply H0.
Check (H (ex_intro _ (fun x => P x -> False) x H0)).
Here, since you already know how to construct a term of type False, you can add it to the context using pose proof. This gives:
pose proof (H (ex_intro (fun x => P x -> False) x H0))
You can even directly destruct the term, which solves the goal.
destruct (H (ex_intro (fun x => P x -> False) x H0))
Another way to finish your proof is to prove False. You can change the goal to False with tactics like exfalso or contradiction. With this approach, you can use hypotheses of the form _ -> False that are otherwise difficult to manipulate. For your proof, you can write:
exfalso. apply H. (* or directly, contradiction H *)
exists x. assumption.
You could use the assert tactic:
assert(w: exists x, P x -> False).
It will ask you to prove this statement in a new sub-goal, and will add w to your existing goal. For this kind of trivial proof, you can inline the proof directly:
assert(w: exists x, P x -> False) by (exists x; exact H0).
I would like to prove that termination implies existence of normal form. These are my definitions:
Section Forms.
Require Import Classical_Prop.
Require Import Classical_Pred_Type.
Context {A : Type}
Variable R : A -> A -> Prop.
Definition Inverse (Rel : A -> A -> Prop) := fun x y => Rel y x.
Inductive ReflexiveTransitiveClosure : Relation A A :=
| rtc_into (x y : A) : R x y -> ReflexiveTransitiveClosure x y
| rtc_trans (x y z : A) : R x y -> ReflexiveTransitiveClosure y z ->
ReflexiveTransitiveClosure x z
| rtc_refl (x y : A) : x = y -> ReflexiveTransitiveClosure x y.
Definition redc (x : A) := exists y, R x y.
Definition nf (x : A) := ~(redc x).
Definition nfo (x y : A) := ReflexiveTransitiveClosure R x y /\ nf y.
Definition terminating := forall x, Acc (Inverse R) x.
Definition normalizing := forall x, (exists y, nfo x y).
End Forms.
I'd like to prove:
Lemma terminating_impl_normalizing (T : terminating):
normalizing.
I have been banging my head against the wall for a couple of hours now, and I've made almost no progress. I can show:
Lemma terminating_not_inf_forall (T : terminating) :
forall f : nat -> A, ~ (forall n, R (f n) (f (S n))).
which I believe should help (this is also true without classic).
Here is a proof using the excluded middle. I reformulated the problem to replace custom definitions by standard ones (note by the way that in your definition of the closure, the rtc_into is redundant with the other ones). I also reformulated terminating using well_founded.
Require Import Classical_Prop.
Require Import Relations.
Section Forms.
Context {A : Type} (R:relation A).
Definition inverse := fun x y => R y x.
Definition redc (x : A) := exists y, R x y.
Definition nf (x : A) := ~(redc x).
Definition nfo (x y : A) := clos_refl_trans _ R x y /\ nf y.
Definition terminating := well_founded inverse. (* forall x, Acc inverse x. *)
Definition normalizing := forall x, (exists y, nfo x y).
Lemma terminating_impl_normalizing (T : terminating):
normalizing.
Proof.
unfold normalizing.
apply (well_founded_ind T). intros.
destruct (classic (redc x)).
- destruct H0 as [y H0]. pose proof (H _ H0).
destruct H1 as [y' H1]. exists y'. unfold nfo.
destruct H1.
split.
+ apply rt_trans with (y:=y). apply rt_step. assumption. assumption.
+ assumption.
- exists x. unfold nfo. split. apply rt_refl. assumption.
Qed.
End Forms.
The proof is not very complicated but here are the main ideas:
use well founded induction
thanks to the excluded middle principle, separate the case where x is not in normal form and the case where it is
if x is not in normal form, use the induction hypothesis and use the transitivity of the closure to conclude
if x is already in normal form, we are done
I have two elements f : X -> bool and x : X.
How to define g : X -> bool such g x = true and g y = f y for y != x.
Following your answer to my comment, I don't think you can define a "function" g, because you need a constructive way do distinguish x from other instances of type X. However you could define a relation between the two, which could be transformed into a function if you get decidability.
Something like:
Parameter X : Type.
Parameter f : X -> bool.
Parameter x : X.
Inductive gRel : X -> bool -> Prop :=
| is_x : gRel x true
| is_not_x : forall y: X, y <> x -> gRel y (f y)
.
Definition gdec (h: forall a b: X, {a = b}+{a <> b}) : X -> bool :=
fun a => if h a x then true else f a.
Lemma gRel_is_a_fun: (forall a b: X, {a = b}+{a <> b}) ->
exists g : X -> bool, forall a, gRel a (g a).
Proof.
intro hdec.
exists (gdec hdec); unfold gdec.
intro a; destruct (hdec a x).
now subst; apply is_x.
now apply is_not_x.
Qed.
Just complementing Vinz's answer, there's no way of defining such a function for arbitrary X, because it implies that X has "almost decidable" equality:
Section Dec.
Variable X : Type.
Variable override : (X -> bool) -> X -> X -> bool.
Hypothesis Hoverride_eq : forall f x, override f x x = true.
Hypothesis Hoverride_neq : forall f x x', x <> x' -> override f x x' = f x'.
Lemma xeq_dec' (x x' : X) : {~ x <> x'} + {x <> x'}.
Proof.
destruct (override (fun _ => false) x x') eqn:E.
- left.
intros contra.
assert (H := Hoverride_neq (fun _ => false) _ _ contra).
simpl in H.
congruence.
- right.
intros contra.
subst x'.
rewrite Hoverride_eq in E.
discriminate.
Qed.
End Dec.
This lemma says that if there's a way of doing what you asked for for X, then one can test whether two elements x and x' of X are equal, except that the proof of equality that one gets in the true case is actually a proof of the double negation of x = x'.