Subsets of list nat in coq - coq

I defined a recursive function for all subsets of nat_list in coq as
Fixpoint subsets (a: list nat) : (list (list nat)) :=
match a with
|[] => [[]]
|h::t => subsets t ++ map (app [h]) (subsets t)
end.
I am trying to prove that
forall (a:list nat), In [] (subsets a).
I tried to induct on a. The base-case was straight forward. However in the induction case i tried to use the in-built theorem in_app_or.
Unable to unify "In ?M1396 ?M1394 \/ In ?M1396 ?M1395" with
"(fix In (a : list nat) (l : list (list nat)) {struct l} : Prop :=
match l with
| [] => False
| b :: m => b = a \/ In a m
end)
[] (subsets t ++ map (fun m : list nat => h :: m) (subsets t))".
How do I prove such a theorem or get around such an issue?

The problem with in_app_or is that is has the following type:
forall (A : Type) (l m : list A) (a : A),
In a (l ++ m) -> In a l \/ In a m
and application of lemmas to the goal works "backwards": Coq matches the consequent B of the implication A -> B with the goal, and if they can be unified, you are left with a new goal: you need to prove a (stronger) statement A. And in your case the A and B are in the wrong order (swapped), so you need to apply in_or_app instead:
in_or_app : forall (A : Type) (l m : list A) (a : A),
In a l \/ In a m -> In a (l ++ m)
This is how your goal can be proved using in_or_app:
Goal forall (a:list nat), In [] (subsets a).
intros.
induction a; simpl; auto.
apply in_or_app; auto.
Qed.

Related

Unfold a type-function in a match (like destruct)

TL;DR
I want to write a fixpoint definition that matches over a value inside a dependent type without proof-mode. The essential issue is that Coq won't use the match to notice that the types are equivalent in a dependent type; I can force it in proof-mode, but I wonder if it's possible to do so without it.
I'm working on a project that involves lots of matrix operations. The matrices can be arbitrarily many dimensions (each of which is rectangular), so I wrote a definition to compute the type of the matrix:
Require Import Coq.Unicode.Utf8.
Require Export Vector.
Import VectorNotations.
Require Import List.
Import ListNotations.
Fixpoint matrix (A: Type) (dims: list nat) :=
match dims with
| [] => A
| head::tail => Vector.t (matrix A tail) head
end.
For "reasons" I need to linearize the elements in order to select the nth element of a linearized matrix. My first attempt was to try to return a single-dimensional matrix, but I ran into a wall with List's fold_left (advice on proceeding would be appreciated):
Definition product (dims: list nat) := List.fold_left Nat.mul dims 1.
Definition linearize {A: Type} {dims: list nat} (m: matrix A dims): matrix A [product dims].
Proof.
generalize dependent m.
induction dims.
- intros.
assert (product [] = 1) by reflexivity. rewrite H; clear H.
exact (Vector.cons A m 0 (Vector.nil A)).
- intros.
(* why so hard? *)
assert (product (a::dims) = a * product dims).
{ unfold product.
assert (a::dims = [a] ++ dims) by reflexivity. rewrite H; clear H.
rewrite List.fold_left_app.
assert (List.fold_left Nat.mul [a] 1 = a). admit. }
Abort.
I decided it might be easier to convert to a list, so:
Fixpoint linearize' {A: Type} {dims: list nat} (m: matrix A dims): list A :=
match dims with
| [] => []
| h::t => Vector.fold_left
(#app A)
[]
(Vector.map linearize' (m: Vector.t (matrix (list A) t) h))
end.
but Coq complains:
In environment
linearize' : ∀ (A : Type) (dims : list nat), matrix A dims → list A
A : Type
dims : list nat
m : matrix A dims
h : nat
t : list nat
The term "m" has type "matrix A dims" while it is expected to have type
"Vector.t (matrix (list A) t) h".
I am able to write the definition using a "proof style," but I am flummoxed that I cannot get Coq to accept the fixpoint that is essentially the same!
Definition linearize {A: Type} {dims: list nat} (m: matrix A dims): list A.
Proof.
induction dims.
- (* unfold matrix in m. *) (* exact [m]. *) apply [m].
- simpl in m.
(* exact (Vector.fold_left (#List.app A) [] (Vector.map IHdims m)). *)
apply (Vector.map IHdims) in m.
apply (Vector.fold_left (#List.app A) [] m).
Defined.
It seems like if I could get Coq to destruct the type of m along with dims, like what happens in induction, I would be good to go… here's Print linearize.
linearize =
λ (A : Type) (dims : list nat) (m : matrix A dims),
list_rect (λ dims0 : list nat, matrix A dims0 → list A)
(λ m0 : matrix A [], [m0])
(λ (a : nat) (dims0 : list nat) (IHdims : matrix A dims0 → list A)
(m0 : matrix A (a :: dims0)),
let m1 := Vector.map IHdims m0 in Vector.fold_left (app (A:=A)) [] m1)
dims m
: ∀ (A : Type) (dims : list nat), matrix A dims → list A
Arguments linearize {A}%type_scope {dims}%list_scope _
My first reaction was "List.fold_left, he's going to have a bad time."
Here's a solution using List.fold_right instead.
Definition product (dims: list nat) := List.fold_right Nat.mul 1 dims.
Fixpoint concat {A} {n m : nat} (v : Vector.t (Vector.t A m) n) : Vector.t A (n * m) :=
match v with
| []%vector => []%vector
| (x :: xs)%vector => append x (concat xs)
end.
Fixpoint linearize {A: Type} {dims: list nat} : matrix A dims -> matrix A [product dims] :=
match dims with
| [] => fun a => (a :: [])%vector
| head :: tail => fun a => concat (Vector.map (linearize (dims := tail)) a)
end.
The problem with fold_left is that, in the non-empty case, it unfolds to an immediate recursive call, which keeps too much information hidden for dependently typed programming. One use case might be to define tail-recursive functions, but this is not applicable here.
With fold_right, whenever you pattern-match on dims, the cons case exposes one Nat.mul which permits one use of concat : Vector.t (Vector.t A m) n -> Vector.t A (n * m).
This is one of the major headaches of using dependent types in Coq. The solution is to rewrite linearize so that it returns a function after matching:
Require Import Coq.Unicode.Utf8.
Require Export Vector.
Import VectorNotations.
Require Import List.
Import ListNotations.
Fixpoint matrix (A: Type) (dims: list nat) :=
match dims with
| [] => A
| head::tail => Vector.t (matrix A tail) head
end.
Fixpoint linearize {A: Type} {dims: list nat} : matrix A dims -> list A :=
match dims with
| [] => fun _ => []
| dim :: dims => fun mat =>
let res := Vector.map (#linearize _ dims) mat in
Vector.fold_left (#app _) [] res
end.
This trick is known as the convoy pattern; you can find more about it here: http://adam.chlipala.net/cpdt/html/MoreDep.html .

Can one prove an equivalent to Forall_inv for heterogeneous lists in Coq?

Following Adam Chlipala's definition of heterogeneous lists, I wanted to define an equivalent of the Forall function on normal lists. This isn't too difficult, and you end up with two constructors as usual. Now suppose that I know that a fact is true about every element of a non-empty list. With normal lists, I could use Forall_inv and Forall_inv_tail to assert that it's true about the head and tail of the list.
I'd like to prove the equivalent for hForall as defined below, starting with the head case. Looking at the source in Lists/List.v, the proof for normal lists is easy and runs by inversion on Forall (a :: l). The equivalent for my hForall gives a mess of dependent variables. Am I missing something obvious?
Require Import List.
Section hlist.
Variable A : Type.
Variable B : A -> Type.
Inductive hlist : list A -> Type :=
| HNil : hlist nil
| HCons {a : A} {ls : list A} : B a -> hlist ls -> hlist (a :: ls).
Section hForall.
Variable P : forall a : A, B a -> Prop.
Inductive hForall : forall {As : list A}, hlist As -> Prop :=
| hForall_nil : hForall HNil
| hForall_cons {a : A} {ls : list A} (x : B a) (hl : hlist ls)
: P a x -> hForall hl -> hForall (HCons x hl).
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
(* Help! *)
Abort.
End hForall.
End hlist.
Inductives indexed by indexed types lead to that kind of difficulty.
Alternatively, consider defining hForall as a Fixpoint. Then the inversion lemma follows by just unfolding the definition.
Section hForall'.
Variable P : forall a, B a -> Prop.
Fixpoint hForall' {As : list A} (hs : hlist As) : Prop :=
match hs with
| HNil => True
| HCons x js => P _ x /\ hForall' js
end.
Lemma hForall'_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall' (HCons x hl) -> P a x.
Proof.
intros []; auto.
Qed.
End hForall'.
Appendix
Mostly for educational purposes, here's a few ways to prove that inversion lemma for the original inductive definition of hForall (starting from the simpler to use).
One solution is the dependent destruction tactic, which also automatically handles heterogeneous equalities, as opposed to destruct. It is imported from the Program module:
Import Program.
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
intros H.
dependent destruction H.
auto.
Qed.
The (minor) catch is that it uses some axioms about heterogeneous equality:
Print Assumptions hForall_inv.
(*
Section Variables:
P : forall a : A, B a -> Prop
B : A -> Type
A : Type
Axioms:
Eqdep.Eq_rect_eq.eq_rect_eq : forall (U : Type) (p : U)
(Q : U -> Type) (x : Q p)
(h : p = p), x = eq_rect p Q x p h
JMeq_eq : forall (A : Type) (x y : A), x ~= y -> x = y
*)
With a little more knowledge of how destruct works/dependent pattern-matching, here's a proof without axioms.
There are some detailed explanations of dependent pattern-matching in CPDT, but briefly the issue is that when we do destruct/inversion on hForall (HCons x hl), the index HCons x hl gets generalized before the case-split, so you get a nonsensical case where it is replaced with HNil, and a second case with a different index HCons x0 hl0, and a good way of remembering the (heterogeneous) equality across that generalization is a research-grade problem. You wouldn't need to mess with heterogeneous equalities if the goal just got rewritten with those variables, and indeed you can refactor the goal so that it explicitly depends on HCons x hl, instead of x and hl separately, which will then be generalized by destruct:
Lemma hForall_inv'
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
intros H.
change (match HCons x hl return Prop with (* for some reason you have to explicitly annotate the return type as Prop right here *)
| HNil => True
| HCons x _ => P _ x
end).
destruct H.
- exact I. (* Replace [HCons x hl] with [HNil], the goal reduces to [True]. (This is an unreachable case.) *)
- assumption.
(* Or, directly writing down the proof term. *)
Restart.
intros H.
refine (match H in #hForall As hs return
match hs return Prop with
| HNil => True
| HCons x _ => P _ x
end
with
| hForall_nil => I
| hForall_cons _ _ _ _ => _
end).
assumption.
Qed.
The Equations plugin probably automates that properly, but I haven't tried.
I think the easiest way to solve this kind of destructing is by telling Coq that we care about these destructed patterns.
Alternately, you can use remember tactic, but sometimes it will make more hard reason about your theorem.
Lemma hForall_inv
(a : A)
(ls : list A)
(x : B a)
(hl : hlist ls)
: hForall (HCons x hl) -> P a x.
Proof.
have : forall (F : forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (H : hForall (HCons x hl)), Prop),
(forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (H : hForall (HCons x hl)) (I : forall (a : A) (ls : list A) (x : B a) (hl : hlist ls) (f : P a x) (H : hForall (HCons x hl)), F a ls x hl H),
F a ls x hl H).
intros.
refine (match H in (hForall (HCons x hl)) return F _ _ _ _ H with
|hForall_nil => _
|hForall_cons a x y z => _
end).
exact idProp.
exact (I _ _ _ _ y (hForall_cons a x y z)).
move => forall_rect.
elim/forall_rect; by [].
Qed.
An observation I am using Type to enables elimination :
Inductive hForall : forall {As : list A}, hlist As -> Type :=
| hForall_nil : hForall HNil
| hForall_cons {a : A} {ls : list A} (x : B a) (hl : hlist ls)
: P a x -> hForall hl -> hForall (HCons x hl).

How can I prove equality of lists by induction?

I'm very new to Coq. Suppose under some hypothesis I want to prove l1 = l2, both of which are lists. I wonder what is a general strategy if I want to prove it inductively.
I don't know of any way to do induction on l1 and l2 at the same time. If I do induction first on l1, then I'll end up having to prove l1 = l2 under hypothesis t1 = l2, where t1 is tail of l1, which is obviously false.
Usually it depends on what kind of hypothesis you have.
However, as a general principle, if you want to synchronise two lists when doing induction on one, you have to generalise over the other.
induction l in l' |- *.
or
revert l'.
induction l.
It might also be that you have some hypothesis on both l and l' on which you can do induction instead.
For instance, the Forall2 predicate synchronises the two lists:
Inductive Forall2 (A B : Type) (R : A -> B -> Prop) : list A -> list B -> Prop :=
| Forall2_nil : Forall2 R [] []
| Forall2_cons : forall (x : A) (y : B) (l : list A) (l' : list B), R x y -> Forall2 R l l' -> Forall2 R (x :: l) (y :: l')
If you do induction on this, it will destruct both lists at the same time.

Coq - How to proof False when hypotesis is wrong

I made an environment to try to proof what I want/need
I have a posfijo function that says if a list (l1) contains another list (l2) at the end.
So if I add an element to the first list and I use the result as the second list, like l2 = x :: l1, I want to proof that is not possible.
I did this...
Variable G:Set.
Inductive posfijo : list _ -> list _ -> Prop :=
| posfijoB : forall l: list _, posfijo l l
| posfijoI : forall (l1 l2: list _) (a : G), posfijo l1 l2 -> posfijo l1 (cons a l2).
Infix "<<" := (posfijo) (at level 70, right associativity).
Lemma Pref4_a : forall (X:Set)(l: list G)(x:G), ~ (cons x l << l).
Proof.
intros X l x H.
So then my goal is
You should proceed with induction l.

Implementing safe element retrieval by index from list in Coq

I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.