Idempotency of normalizing a binary number in coq - coq

I want to proof the idempotency of a function normalize that takes a binary number (as defined below, do note that B0 (B1 Z) == 2, so that they are read right to left) and normalizes it by removing leading 0s.
Inductive bin : Type :=
| Z
| B0 (n : bin)
| B1 (n : bin).
Fixpoint normalize (m: bin) : bin :=
match m with
| Z => Z
| B0 Z => Z
| B0 m' =>
match (normalize m') with
| Z => Z
| m'' => B0 m''
end
| B1 m' => B1 (normalize m')
end.
Theorem normalize_idemp :
forall b: bin, normalize b = normalize (normalize b).
Proof.
induction b as [| b' IHb' | c' IHc'].
- simpl. reflexivity.
- simpl. ???
Qed.
However I am stuck at the proof where I marked ???. I tried destructing b', but that does not help as I just get inside even m ore match patterns. How to complete the proof?

Destructing b does work :
Theorem normalize_idemp :
forall b: bin, normalize b = normalize (normalize b).
Proof.
induction b ; cbn.
- easy.
- destruct b.
+ easy.
+ destruct (normalize (B0 b)).
* easy.
* cbn in *.
now rewrite <- IHb.
* cbn. now rewrite IHb.
+ cbn in *.
now rewrite IHb.
- now rewrite <- IHb.
Qed.
Note however that the fact that you single out the case of B0 Z makes the proof by induction unnecessarily involved. Instead you can simplify your definition to the following (try and prove both are equivalent if you want to convince yourself):
Fixpoint normalize' (m: bin) : bin :=
match m with
| Z => Z
| B0 m' =>
match (normalize' m') with
| Z => Z
| m'' => B0 m''
end
| B1 m' => B1 (normalize' m')
end.
and the proof by induction is then even more straightforward.

Related

Logic: In_example_2

Here is the code from the book:
Example In_example_2 :
forall n, In n [2; 4] ->
exists n', n = 2 * n'.
Proof.
(* WORKED IN CLASS *)
simpl.
intros n [H | [H | []]].
- exists 1. rewrite <- H. reflexivity.
- exists 2. rewrite <- H. reflexivity.
Qed.
After simpl. In is transformed into a disjunction of 3 elements:
============================
forall n : nat, 2 = n \/ 4 = n \/ False -> exists n' : nat, n = n' + (n' + 0)
But I totally don't understand how to read this:
intros n [H | [H | []]].
It produced this:
n : nat
H : 2 = n
============================
exists n' : nat, n = n' + (n' + 0)
subgoal 2 (ID 229) is:
exists n' : nat, n = n' + (n' + 0)
What I understood:
It put n from forall into the context.
It split disjunction of 3 elements into 2 subgoals, ignoring False:
Created 2 subgoals according to the number of splits.
There is also a notice at the bottom:
(** (Notice the use of the empty pattern to discharge the last case
_en passant_.) *)
En passant (French: [ɑ̃ paˈsɑ̃], lit. in passing) is a move in
chess. It is a special pawn capture that can only occur immediately
after a pawn makes a move of two squares from its starting square, and
when it could have been captured by an enemy pawn had it advanced only
one square.
Looking at this:
intros n [H | [H | []]].
Can somebody explain me:
Should command of this form be used for destructing forall? Is there something else for this task?
How to read this command in English?
Why [H | []] was put into another pair of brackets?
How [] told coq to ignore the False statement?
When this command should be used in general?
The intros n [H | [H | []]] form is a shorthand for
intros n H. destruct H as [H | [H | []]].
You can further rewrite the proof as
intros n H. destruct H as [H2 | H4F].
- (* H2 : 2 = n *)
exists 1. rewrite <- H2. reflexivity.
- (* H4F : 4 = n \/ False *)
destruct H4F as [H4 | HF].
+ (* H4 : 4 = n *)
exists 2. rewrite <- H4. reflexivity.
+ (* HF : False *)
destruct HF. (* No more subgoals here *)
The two proofs are logically equivalent, but the first one is shorter (and easier to read, once you get used to the syntax).
Generally speaking, the tactic destruct x as [...] takes the expression x and generates one subgoal for each constructor that could have been used to produce x. The arguments to the constructors are named according to the pattern [...], and the parts corresponding to the different constructors are separated by vertical bars.
A proposition of the form A \/ B \/ C should be read as A \/ (B \/ C). Thus, when you call destruct for the first time in the expanded form above, you get two cases: when for when A holds, the other one for when B \/ C holds. You need to call destruct a second time to analyze the inner or, which is why you had nested brackets in the original expression. As for the last branch, False is defined as a proposition with no constructors, so once you destruct a hypothesis HF : False, the proof is complete.
(Here, "en passant" is equivalent to the English "in passing", roughly meaning "incidentally". It refers to the fact that we are discharging the last case as a by-product of doing a case analysis on the or hypothesis.)

How to destruct values of expressions?

I'm learning Coq and try to proof next seemingly simple property.
Basically, I need to consider all the cases for eqb x y,
but my usual approach using destruct and induction tactics fails here.
Fixpoint eqb (x:nat) (y: nat) :bool :=
match x,y with
| 0, 0 => true
| S xx, S yy => eqb xx yy
| _,_ => false
end.
Definition bool_to_nat (b:bool) :nat :=
match b with
| true => 1
| false => 0
end.
Theorem should_be_easy: forall x:nat, forall y : nat,
bool_to_nat (eqb x y) + bool_to_nat (negb (eqb x y)) = 1.
intros x y. Abort.
intros x y.
destruct (eqb x y).

How to prove decidability of a partial order inductive predicate?

Context
I am trying to define the partial order A ≤ B ≤ C with a relation le in Coq and prove that it is decidable: forall x y, {le x y} + {~le x y}.
I succeeded to do it through an equivalent boolean function leb but cannot find a way to prove it directly (or le_antisym for that mater). I get stuck in situations like the following:
1 subgoal
H : le C A
______________________________________(1/1)
False
Questions
How can I prove, that le C A is a false premise?
Is there an other other proof strategy that I should use?
Should I define my predicate le differently?
Minimal executable example
Require Import Setoid.
Ltac inv H := inversion H; clear H; subst.
Inductive t : Set := A | B | C.
Ltac destruct_ts :=
repeat match goal with
| [ x : t |- _ ] => destruct x
end.
Inductive le : t -> t -> Prop :=
| le_refl : forall x, le x x
| le_trans : forall x y z, le x y -> le y z -> le x z
| le_A_B : le A B
| le_B_C : le B C .
Definition leb (x y : t) : bool :=
match x, y with
| A, _ => true
| _, C => true
| B, B => true
| _, _ => false
end.
Theorem le_iff_leb : forall x y,
le x y <-> leb x y = true.
Proof.
intros x y. split; intro H.
- induction H; destruct_ts; simpl in *; congruence.
- destruct_ts; eauto using le; simpl in *; congruence.
Qed.
Theorem le_antisym : forall x y,
le x y -> le y x -> x = y.
Proof.
intros x y H1 H2.
rewrite le_iff_leb in *. (* How to prove that without using [leb]? *)
destruct x, y; simpl in *; congruence.
Qed.
Theorem le_dec : forall x y, { le x y } + { ~le x y }.
intros x y.
destruct x, y; eauto using le.
- apply right.
intros H. (* Stuck here *)
inv H.
rewrite le_iff_leb in *.
destruct y; simpl in *; congruence.
- apply right.
intros H; inv H. (* Same thing *)
rewrite le_iff_leb in *.
destruct y; simpl in *; congruence.
- apply right.
intros H; inv H. (* Same thing *)
rewrite le_iff_leb in *.
destruct y; simpl in *; congruence.
Qed.
The problem with le is the transitivity constructor: when doing inversion or induction on a proof of le x y, we know nothing about the middle point that comes out of the transitivity case, which often leads to failed proof attempts. You can prove your result with an alternative (but still inductive) characterization of the relation:
Require Import Setoid.
Ltac inv H := inversion H; clear H; subst.
Inductive t : Set := A | B | C.
Inductive le : t -> t -> Prop :=
| le_refl : forall x, le x x
| le_trans : forall x y z, le x y -> le y z -> le x z
| le_A_B : le A B
| le_B_C : le B C .
Inductive le' : t -> t -> Prop :=
| le'_refl : forall x, le' x x
| le'_A_B : le' A B
| le'_B_C : le' B C
| le'_A_C : le' A C.
Lemma le_le' x y : le x y <-> le' x y.
Proof.
split.
- intros H.
induction H as [x|x y z xy IHxy yz IHyz| | ]; try now constructor.
inv IHxy; inv IHyz; constructor.
- intros H; inv H; eauto using le.
Qed.
Theorem le_antisym : forall x y,
le x y -> le y x -> x = y.
Proof.
intros x y.
rewrite 2!le_le'.
intros []; trivial; intros H; inv H.
Qed.
Theorem le_dec : forall x y, { le x y } + { ~le x y }.
intros x y.
destruct x, y; eauto using le; right; rewrite le_le';
intros H; inv H.
Qed.
In this case, however, I think that using an inductive characterization of le is not a good idea, because the boolean version is more useful. Naturally, there are occasions where you would like two characterizations of a relation: for instance, sometimes you would like a boolean test for equality on a type, but would like to use = for rewriting. The ssreflect proof language makes it easy to work in this style. For instance, here is another version of your first proof attempt. (The reflect P b predicate means that the proposition P is equivalent to the assertion b = true.)
From mathcomp Require Import ssreflect ssrfun ssrbool.
Inductive t : Set := A | B | C.
Inductive le : t -> t -> Prop :=
| le_refl : forall x, le x x
| le_trans : forall x y z, le x y -> le y z -> le x z
| le_A_B : le A B
| le_B_C : le B C .
Definition leb (x y : t) : bool :=
match x, y with
| A, _ => true
| _, C => true
| B, B => true
| _, _ => false
end.
Theorem leP x y : reflect (le x y) (leb x y).
Proof.
apply/(iffP idP); first by case: x; case y=> //=; eauto using le.
by elim=> [[]| | |] //= [] [] [].
Qed.
Theorem le_antisym x y : le x y -> le y x -> x = y.
Proof. by case: x; case: y; move=> /leP ? /leP ?. Qed.
Theorem le_dec : forall x y, { le x y } + { ~le x y }.
Proof. by move=> x y; case: (leP x y); eauto. Qed.
I'd also go with Arthur's solution. But let me demonstrate another approach.
First, we'll need a couple of supporting lemmas:
Lemma not_leXA x : x <> A -> ~ le x A.
Proof. remember A; intros; induction 1; subst; firstorder congruence. Qed.
Lemma not_leCX x : x <> C -> ~ le C x.
Proof. remember C; intros; induction 1; subst; firstorder congruence. Qed.
Now we can define le_dec:
Definition le_dec x y : { le x y } + { ~le x y }.
Proof.
destruct x, y; try (left; abstract constructor).
- left; abstract (eapply le_trans; constructor).
- right; abstract now apply not_leXA.
- right; abstract now apply not_leCX.
- right; abstract now apply not_leCX.
Defined.
Notice that I used Defined instead of Qed -- now you can calculate with le_dec, which is usually the point of using the sumbool type.
I also used abstract to conceal the proof terms from the evaluator. E.g. let's imagine I defined a le_dec' function which is the same as le_dec, but with all abstract removed, then we would get the following results when trying to compute le_dec B A / le_dec' B A :
Compute le_dec B A.
(* ==> right le_dec_subproof5 *)
and
Compute le_dec' B A.
(* ==> right
(not_leXA B
(fun x : B = A =>
match x in (_ = x0) return (x0 = A -> False) with
| eq_refl =>
fun x0 : B = A =>
match
match
x0 in (_ = x1)
return match x1 with
| B => True
| _ => False
end
with
| eq_refl => I
end return False
with
end
end eq_refl)) *)
Note that you can make use of the definitions in Relations to define your order relation. For instance, it contains a definition of reflexive and transitive closure named clos_refl_trans. The resulting proofs are similar to those based on your definitions (cf. #Anton's answer).
Require Import Relations.
Inductive t : Set := A | B | C.
Inductive le : t -> t -> Prop :=
| le_A_B : le A B
| le_B_C : le B C.
Definition le' := clos_refl_trans _ le.
Lemma A_minimal : forall x, x <> A -> ~ le' x A.
Proof.
intros. intros contra. remember A as a. induction contra; subst.
- inversion H0.
- contradiction.
- destruct y; apply IHcontra2 + apply IHcontra1; congruence.
Qed.
Lemma C_maximal : forall x, x <> C -> ~ le' C x.
Proof.
intros. intros contra. remember C as c. induction contra; subst.
- inversion H0.
- contradiction.
- destruct y; apply IHcontra2 + apply IHcontra1; congruence.
Qed.
Lemma le'_antisym : forall x y,
le' x y -> le' y x -> x = y.
Proof.
intros. induction H.
- destruct H.
+ apply A_minimal in H0; try discriminate. contradiction.
+ apply C_maximal in H0; try discriminate. contradiction.
- reflexivity.
- fold le' in *. rewrite IHclos_refl_trans1 by (eapply rt_trans; eassumption).
apply IHclos_refl_trans2; (eapply rt_trans; eassumption).
Qed.

Getting a stronger induction principle in Coq

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.

Rewriting a match in Coq

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.