I am very new to Coq and I'm trying to prove that if two functions are injectives, the composition of theses two functions is also injective.
Here is my code:
Definition compose {A B C} (g: B -> C) (f: A -> B) :=
fun x : A => g (f x).
Definition injective {A B} (f: A -> B) :=
forall x1 x2, f x1 = f x2 -> x1 = x2.
(*
Definition surjective {A B} (f: A -> B) :=
forall y: B, exists x: A, f x = y.
*)
Theorem example {A B C} (g: B -> C) (f: A -> B) :
injective f /\ injective g -> injective (compose g f).
Proof.
intros.
destruct H as (H1,H2).
cut (forall x1 x2: A, (compose g f) x1 = (compose g f) x2).
intros.
unfold compose in H.
unfold injective in H2.
The result is:
2 goals
A : Type
B : Type
C : Type
g : B -> C
f : A -> B
H1 : injective f
H2 : forall x1 x2 : B, g x1 = g x2 -> x1 = x2
H : forall x1 x2 : A, g (f x1) = g (f x2)
______________________________________(1/2)
injective (compose g f)
______________________________________(2/2)
forall x1 x2 : A, compose g f x1 = compose g f x2
From this state, I am trying to apply H2 in H in order to prove that f(x1)=f(x2). I have tried the apply tactic as well as the specialized tactic but none of them worked.
Here is the actual proof I am following :
EDIT:
Thank you very much for you help! This code works now :
Theorem compose_injective {A B C} (g: B -> C) (f: A -> B) :
injective f /\ injective g -> injective (compose g f).
Proof.
intros.
destruct H as (H1,H2).
unfold injective.
intros.
unfold injective in H2.
apply H2 in H.
unfold injective in H1.
apply H1 in H.
exact H.
Instead of cut, use unfold injective. to reveal the hypothesis compose g f x = compose g f x'.
apply H2 in H says you're missing an x1 and x2. First get yourself an x1 and x2 by unfolding injective in your goal and using intros. Then you can apply H2 (with appropriate parameters) in H1.
Related
I'm new to Coq and try to learn it through Software foundations. In the chapter "Logic in Coq", there is an exercise not_exists_dist which I completed (by guessing) but not understand:
Theorem not_exists_dist :
excluded_middle →
∀ (X:Type) (P : X → Prop),
¬ (∃ x, ¬ P x) → (∀ x, P x).
Proof.
intros em X P H x.
destruct (em (P x)) as [T | F].
- apply T.
- destruct H. (* <-- This step *)
exists x.
apply F.
Qed.
Before the destruct, the context and goal looks like:
em: excluded_middle
X: Type
P: X -> Prop
H: ~ (exists x : X, ~ P x)
x: X
F: ~ P x
--------------------------------------
(1/1)
P x
And after it
em: excluded_middle
X: Type
P: X -> Prop
x: X
F: ~ P x
--------------------------------------
(1/1)
exists x0 : X, ~ P x0
While I understand destruct on P /\ Q and P \/ Q in hypothesis, I don't understand how it works on P -> False like here.
Let me try to give some intuition behind this by doing another proof first.
Consider:
Goal forall A B C : Prop, A -> C -> (A \/ B -> B \/ C -> A /\ B) -> A /\ B.
Proof.
intros. (*eval up to here*)
Admitted.
What you will see in *goals* is:
1 subgoal (ID 77)
A, B, C : Prop
H : A
H0 : C
H1 : A ∨ B → B ∨ C → A ∧ B
============================
A ∧ B
Ok, so we need to show A /\ B. We can use split to break the and apart, thus we need to show A and B. A follows easily by assumption, B is something we do not have. So, our proof script now might look like:
Goal forall A B C : Prop, A -> C -> (A \/ B -> B \/ C -> A /\ B) -> A /\ B.
Proof.
intros. split; try assumption. (*eval up to here*)
Admitted.
With goals:
1 subgoal (ID 80)
A, B, C : Prop
H : A
H0 : C
H1 : A ∨ B → B ∨ C → A ∧ B
============================
B
The only way we can get to the B is by somehow using H1. Let's see what destruct H1 does to our goals:
3 subgoals (ID 86)
A, B, C : Prop
H : A
H0 : C
============================
A ∨ B
subgoal 2 (ID 87) is:
B ∨ C
subgoal 3 (ID 93) is:
B
We get additional subgoals! In order to destruct H1 we need to provide it proofs for A \/ B and B \/ C, we cannot destruct A /\ B otherwise!
For the sake of completeness: (without the split;try assumption shorthand)
Goal forall A B C : Prop, A -> C -> (A \/ B -> B \/ C -> A /\ B) -> A /\ B.
Proof.
intros. split.
- assumption.
- destruct H1.
+ left. assumption.
+ right. assumption.
+ assumption.
Qed.
Another way to view it is this: H1 is a function that takes A \/ B and B \/ C as input. destruct works on its output. In order to destruct the result of such a function, you need to give it an appropriate input.
Then, destruct performs a case analysis without introducing additional goals.
We can do that in the proof script as well before destructing:
Goal forall A B C : Prop, A -> C -> (A \/ B -> B \/ C -> A /\ B) -> A /\ B.
Proof.
intros. split.
- assumption.
- specialize (H1 (or_introl H) (or_intror H0)).
destruct H1.
assumption.
Qed.
From a proof term perspective, destruct of A /\ B is the same as match A /\ B with conj H1 H2 => (*construct a term that has your goal as its type*) end.
We can replace the destruct in our proof script with a corresponding refine that does exactly that:
Goal forall A B C : Prop, A -> C -> (A \/ B -> B \/ C -> A /\ B) -> A /\ B.
Proof.
intros. unfold not in H0. split.
- assumption.
- specialize (H1 (or_introl H) (or_intror H0)).
refine (match H1 with conj Ha Hb => _ end).
exact Hb.
Qed.
Back to your proof. Your goals before destruct
em: excluded_middle
X: Type
P: X -> Prop
H: ~ (exists x : X, ~ P x)
x: X
F: ~ P x
--------------------------------------
(1/1)
P x
After applying the unfold not in H tactic you see:
em: excluded_middle
X: Type
P: X -> Prop
H: (exists x : X, P x -> ⊥) -> ⊥
x: X
F: ~ P x
--------------------------------------
(1/1)
P x
Now recall the definition of ⊥: It's a proposition that cannot be constructed, i.e. it has no constructors.
If you somehow have ⊥ as an assumption and you destruct, you essentially look at the type of match ⊥ with end, which can be anything.
In fact, we can prove any goal with it:
Goal (forall (A : Prop), A) <-> False. (* <- note that this is different from *)
Proof. (* forall (A : Prop), A <-> False *)
split; intros.
- specialize (H False). assumption.
- refine (match H with end).
Qed.
Its proofterm is:
(λ (A B C : Prop) (H : A) (H0 : C) (H1 : A ∨ B → B ∨ C → A ∧ B),
conj H (let H2 : A ∧ B := H1 (or_introl H) (or_intror H0) in match H2 with
| conj _ Hb => Hb
end))
Anyhow, destruct on your assumption H will give you a proof for your goal if you are able to show exists x : X, ~ P x -> ⊥.
Instead of destruct, you could also do exfalso. apply H. to achieve the same thing.
Normally, destruct t applies when t is an inhabitant of an inductive type I, giving you one goal for each possible constructor for I that could have been used to produce t. Here as you remarked H has type P -> False, which is not an inductive type, but False is. So what happens is this: destruct gives you a first goal corresponding to the P hypothesis of H. Applying H to that goal leads to a term of type False, which is an inductive type, on which destruct works as it should, giving you zero goals since False has no constructors. Many tactics for inductive types work like this on hypothesis of the form P1 -> … -> Pn -> I where I is an inductive type: they give you side-goals for P1 … Pn, and then work on I.
A monic and epic function is an isomorphism, hence it has an inverse. I'd like a proof of that in Coq.
Axiom functional_extensionality: forall A B (f g : A->B), (forall a, f a = g a) -> f = g.
Definition compose {A B C} (f : B->C) (g: A->B) a := f (g a).
Notation "f ∘ g" := (compose f g) (at level 40).
Definition id {A} (a:A) := a.
Definition monic {A B} (f:A->B) := forall C {h k:C->A}, f ∘ h = f ∘ k -> h = k.
Definition epic {A B} (f:A->B) := forall C {h k:B->C}, h ∘ f = k ∘ f -> h = k.
Definition iso {A B} (f:A->B) := monic f /\ epic f.
Goal forall {A B} (f:A->B), iso f -> exists f', f∘f' = id /\ f'∘f = id.
The proofs I have found online (1, 2) do not give a construction of f' (the inverse). Is it possible to show this in Coq? (It is not obvious to me that the inverse is computable...)
First, a question of terminology. In category theory, an isomorphism is a morphism that has a left and a right inverse, so I am changing slightly your definitions:
Definition compose {A B C} (f : B->C) (g: A->B) a := f (g a).
Notation "f ∘ g" := (compose f g) (at level 40).
Definition id {A} (a:A) := a.
Definition monic {A B} (f:A->B) := forall C {h k:C->A}, f ∘ h = f ∘ k -> h = k.
Definition epic {A B} (f:A->B) := forall C {h k:B->C}, h ∘ f = k ∘ f -> h = k.
Definition iso {A B} (f:A->B) :=
exists g : B -> A, f ∘ g = id /\ g ∘ f = id.
It is possible to prove this result by assuming a few standard axioms, namely propositional extensionality and constructive definite description (a.k.a. the axiom of unique choice):
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.PropExtensionality.
Require Import Coq.Logic.Description.
Section MonoEpiIso.
Context (A B : Type).
Implicit Types (f : A -> B) (x : A) (y : B).
Definition surjective f := forall y, exists x, f x = y.
Lemma epic_surjective f : epic f -> surjective f.
Proof.
intros epic_f y.
assert (H : (fun y => exists x, f x = y) = (fun y => True)).
{ apply epic_f.
apply functional_extensionality.
intros x; apply propositional_extensionality; split.
- intros _; exact I.
- now intros _; exists x. }
now pattern y; rewrite H.
Qed.
Definition injective f := forall x1 x2, f x1 = f x2 -> x1 = x2.
Lemma monic_injective f : monic f -> injective f.
Proof.
intros monic_f x1 x2 e.
assert (H : f ∘ (fun a : unit => x1) = f ∘ (fun a : unit => x2)).
{ now unfold compose; simpl; rewrite e. }
assert (e' := monic_f _ _ _ H).
exact (f_equal (fun g => g tt) e').
Qed.
Lemma monic_epic_iso f : monic f /\ epic f -> iso f.
Proof.
intros [monic_f epic_f].
assert (Hf : forall y, exists! x, f x = y).
{ intros y.
assert (sur_f := epic_surjective _ epic_f).
destruct (sur_f y) as [x xP].
exists x; split; trivial.
intros x' x'P.
now apply (monic_injective _ monic_f); rewrite xP, x'P. }
exists (fun a => proj1_sig (constructive_definite_description _ (Hf a))).
split; apply functional_extensionality; unfold compose, id.
- intros y.
now destruct (constructive_definite_description _ (Hf y)).
- intros x.
destruct (constructive_definite_description _ (Hf (f x))); simpl.
now apply (monic_injective _ monic_f).
Qed.
End MonoEpiIso.
I believe it is not possible to prove this result without at least some form of unique choice. Assume propositional and functional extensionality. Note that, if exists! x : A, P x holds, then the unique function
{x | P x} -> unit
is both injective and surjective. (Injectivity follows from the uniqueness part, and surjectivity follows from the existence part.) If this function had an inverse for every P : A -> Type, then we could use this inverse to implement the axiom of unique choice. Since this axiom does not hold in Coq, it shouldn't be possible to build this inverse in the basic theory.
Lemma In_map_iff :
forall (A B : Type) (f : A -> B) (l : list A) (y : B),
In y (map f l) <->
exists x, f x = y /\ In x l.
Proof.
split.
- generalize dependent y.
generalize dependent f.
induction l.
+ intros. inversion H.
+ intros.
simpl.
simpl in H.
destruct H.
* exists x.
split.
apply H.
left. reflexivity.
*
1 subgoal
A : Type
B : Type
x : A
l : list A
IHl : forall (f : A -> B) (y : B),
In y (map f l) -> exists x : A, f x = y /\ In x l
f : A -> B
y : B
H : In y (map f l)
______________________________________(1/1)
exists x0 : A, f x0 = y /\ (x = x0 \/ In x0 l)
Since proving exists x0 : A, f x0 = y /\ (x = x0 \/ In x0 l) is the same as proving exists x0 : A, f x0 = y /\ In x0 l, I want to eliminate x = x0 inside the goal here so I can apply the inductive hypothesis, but I am not sure how to do this. I've tried left in (x = x0 \/ In x0 l) and various other things, but I haven't been successful in making it happen. As it turns out, defining a helper function of type forall a b c, (a /\ c) -> a /\ (b \/ c) to do the rewriting does not work for terms under an existential either.
How could this be done?
Note that the above is one of the SF book exercises.
You can get access to the components of your inductive hypothesis with any of the following:
specialize (IHl f y h); destruct IHl
destruct (IHl f y H)
edestruct IHl
You can then use exists and split to manipulate the goal into a form that is easier to work with.
As it turns out, it is necessary to define a helper.
Lemma In_map_iff_helper : forall (X : Type) (a b c : X -> Prop),
(exists q, (a q /\ c q)) -> (exists q, a q /\ (b q \/ c q)).
Proof.
intros.
destruct H.
exists x.
destruct H.
split.
apply H.
right.
apply H0.
Qed.
This does the rewriting that is needed right off the bat. I made a really dumb error thinking that I needed a tactic rather than an auxiliary lemma. I should have studied the preceding examples more closely - if I did, I'd have realized that existentials need to be accounted for.
Would anyone explain to me why the same tactics (destruct) applied to the same hypothesis (bijective f) works in the first lemma and not in the second? Also, what should I do in order to fix it? I guess it has to do with mixing Prop and Type in the statement of the second lemma, but I don´t understand exactly what is happening here. Thank you in advance.
Require Import Setoid.
Definition injective {A B: Type} (f: A->B) :=
forall x y: A, f x = f y -> x = y.
Definition bijective {A B: Type} (f: A->B) :=
exists g: B->A, (forall x: A, g (f x) = x) /\ (forall y: B, f (g y) = y).
Definition decidable (t: Type): Type:=
(forall x y: t, {x=y}+{x<>y}).
Lemma bijective_to_injective:
forall t1 t2: Type,
forall f: t1 -> t2,
bijective f -> injective f.
Proof.
intros t1 t2 f H1.
destruct H1 as [g [H1 H2]]. (* <--- WORKS HERE *)
intros x y H3.
rewrite <- H1.
rewrite <- H1 at 1.
rewrite H3.
reflexivity.
Qed.
Lemma bijective_dec:
forall t1 t2: Type,
forall f: t1 -> t2,
bijective f ->
decidable t1 ->
decidable t2.
Proof.
intros t1 t2 f H1 H2 x y.
destruct H1 as [g [H1 H2]]. (* <--- DOESN´T WORK HERE *)
Qed.
Indeed your problem is that you need a so-called "informative definition" for bijective that is to say, one where you can extract the actual witness such as:
{ g: B -> A | cancel f g /\ cancel g f }
In Coq, suppose I have a fixpoint function f whose matching definition on (g x), and I want to use a hypothesis in the form (g x = ...) in a proof. The following is a minimal working example (in reality f, g would be more complicated):
Definition g (x:nat) := x.
Fixpoint f (x:nat) :=
match g x with
| O => O
| S y => match x with
| O => S O
| S z => f z
end
end.
Lemma test : forall (x : nat), g x = O -> f x = O.
Proof.
intros.
unfold f.
rewrite H. (*fails*)
The message shows where Coq gets stuck:
(fix f (x0 : nat) : nat :=
match g x0 with
| 0 => 0
| S _ => match x0 with
| 0 => 1
| S z0 => f z0
end
end) x = 0
Error: Found no subterm matching "g x" in the current goal.
But, the commands unfold f. rewrite H. does not work.
How do I get Coq to unfold f and then use H ?
Parameter g: nat -> nat.
(* You could restructure f in one of two ways: *)
(* 1. Use a helper then prove an unrolling lemma: *)
Definition fhelp fhat (x:nat) :=
match g x with
| O => O
| S y => match x with
| O => S O
| S z => fhat z
end
end.
Fixpoint f (x:nat) := fhelp f x.
Lemma funroll : forall x, f x = fhelp f x.
destruct x; simpl; reflexivity.
Qed.
Lemma test : forall (x : nat), g x = O -> f x = O.
Proof.
intros.
rewrite funroll.
unfold fhelp.
rewrite H.
reflexivity.
Qed.
(* 2. Use Coq's "Function": *)
Function f2 (x:nat) :=
match g x with
| O => O
| S y => match x with
| O => S O
| S z => f2 z
end
end.
Check f2_equation.
Lemma test2 : forall (x : nat), g x = O -> f2 x = O.
Proof.
intros.
rewrite f2_equation.
rewrite H.
reflexivity.
Qed.
I'm not sure if this would solve the general problem, but in your particular case (since g is so simple), this works:
Lemma test : forall (x : nat), g x = O -> f x = O.
Proof.
unfold g.
intros ? H. rewrite H. reflexivity.
Qed.
Here is another solution, but of course for this trivial example. Perhaps will give you some idea.
Lemma test2 : forall (x : nat), g x = O -> f x = O.
Proof.
=>intros;
pattern x;
unfold g in H;
rewrite H;
trivial.
Qed.