I am trying to prove something simple:
open import Data.List
open import Data.Nat
open import Data.Bool
open import Data.Bool.Properties
open import Relation.Binary.PropositionalEquality
open import Data.Unit
repeat : ∀ {a} {A : Set a} → ℕ → A → List A
repeat zero x = []
repeat (suc n) x = x ∷ repeat n x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
I thought proving filter-repeat is going to be easy by pattern matching on p x:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x
filter-repeat p x () (suc n) | false
filter-repeat p x prf (suc n) | true = cong (_∷_ x) (filter-repeat p x prf n)
However this complains that prf : ⊤ is not of type T (p x). So I thought, OK, this seems like a familiar problem, let's whip out inspect:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] rewrite eq = cong (_∷_ x) (filter-repeat p x {!!} n)
but despite the rewrite, the type of the hole is still T (p x) instead of T true. Why is that? How do I reduce its type to T true so I can fill it with tt?
Workaround
I was able to work around it by using T-≡:
open import Function.Equality using (_⟨$⟩_)
open import Function.Equivalence
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] = cong (_∷_ x) (filter-repeat p x (Equivalence.from T-≡ ⟨$⟩ eq) n)
but I would still like to understand why the inspect-based solution doesn't work.
As András Kovács says the inductive case requires prf to be of type T (p x) while you've already changed it to just ⊤ by pattern matching on p x. One simple solution is just to call filter-repeat recursively before pattern matching on p x:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf 0 = refl
filter-repeat p x prf (suc n) with filter-repeat p x prf n | p x
... | r | true = cong (x ∷_) r
... | r | false = ⊥-elim prf
It also can sometimes be useful to use the protect pattern:
data Protect {a} {A : Set a} : A → Set where
protect : ∀ x → Protect x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x q 0 = refl
filter-repeat p x q (suc n) with protect q | p x | inspect p x
... | _ | true | [ _ ] = cong (x ∷_) (filter-repeat p x q n)
... | _ | false | [ r ] = ⊥-elim (subst T r q)
protect q saves the type of q from being rewritten, but it also means that in the false case the type of q is still T (p x) rather than ⊥, hence the additional inspect.
Another variant of the same idea is
module _ {a} {A : Set a} (p : A → Bool) (x : A) (prf : T (p x)) where
filter-repeat : ∀ n → filter p (repeat n x) ≡ repeat n x
filter-repeat 0 = refl
filter-repeat (suc n) with p x | inspect p x
... | true | [ r ] = cong (x ∷_) (filter-repeat n)
... | false | [ r ] = ⊥-elim (subst T r prf)
module _ ... (prf : T (p x)) where prevents the type of prf from being rewritten as well.
Dependent pattern matching only affects the goal and the context at the exact point of their use. Matching on p xrewrites the current context and reduces the type of prf to ⊤ in the true branch.
However, when you do the recursive filter-repeat call, you once again supply x as argument there, and T (p x) in filter-repeat depends on that x, not the old one in the outer context, even though they're definitionally equal. We could've passed something other than x, hypothetically, so no assumption can be made about it before the filter-repeat call.
x can be made invariant in the context by factoring it out from the induction:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf = go where
go : ∀ n → filter p (repeat n x) ≡ repeat n x
go zero = refl
go (suc n) with p x | inspect p x
go (suc n) | true | [ eq ] = cong (_∷_ x) (go n)
go (suc n) | false | [ eq ] = ⊥-elim (subst T eq prf)
Related
First, in the case of usual open formula,
Require Import Coq.Init.Nat.
Variable x : nat.
Lemma test1:
~ exists a : nat,
let x := a in
x * x = 2.
Proof.
simpl. Admitted.
I can see that a binds to x, after simpl..
1 subgoal
______________________________________(1/1)
~ (exists a : nat, a * a = 2)
Now, I write wrapped open formula formula based on Prop,
with an unwrap operation f2p.
Require Import Coq.Init.Nat.
Require Import Lists.List.
Import ListNotations.
(* I: injection, A: and, T: then, S: square *)
Inductive formula := I (p : Prop) | A (f g : formula) | T (p : Prop) (f : formula) | S (f : formula).
(* unwrap formula to prop *)
Fixpoint f2p (f : formula) : Prop :=
match f with
| I p => p
| A f g => f2p(f) /\ f2p(g)
| T p f => p -> f2p(f)
| _ => True
end.
Definition andl (l : list Prop) : Prop :=
fold_left and l True.
Variable x : nat.
Lemma test2:
let l := [I (x*x = 2)] in
~ exists a : nat,
let x := a in
andl (map f2p l).
Proof.
unfold andl. simpl.
Admitted.
But in this case, I can NOT see that a binds to x, after simpl..
1 subgoal
______________________________________(1/1)
~ (exists _ : nat, True /\ x * x = 2)
You cannot see it because it is not what happens.
You have expression
let x := a in andl (map f2p l)
which does define x to be a in andl (map f2p l) but this term does not mention x as you can see. It does mention another variable called x:
Variable x : nat.
but they are not the same!
When you write let x := a in exp you have a local definition x := a in the context of expression exp so you can write let x := a in x * x and it will reduce to a * a.
What you are trying to do is not do a local definition but instantiating a variable, the way this is done is by using function application.
let l := fun x => [I (x*x = 2)] in
~ exists a : nat,
let x := a in
andl (map f2p (l x)).
I am currently going through the book 'Computational Type Theory and Interactive Theorem Proving with Coq' by Gert Smolka, and on page 93, the following inductive predicate is defined:
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Then on page 95 it is argued that one can define an eliminator:
Definition elimG : forall (f:nat -> bool) (p:nat -> Type),
(forall (n:nat), (f n = false -> p (S n)) -> p n) ->
forall (n:nat), G f n -> p n.
Proof.
...
The book spells out an expression of a term of this type, namely:
elimG f p g n (mkG _ _ h) := g n (λe. elimG f p g (S n) (h e))
(I have changed a few notations for the purpose of this post)
which I formally translated as:
refine (
fun (f:nat -> bool) (p:nat -> Type) =>
fun (H1:forall (n:nat), (f n = false -> p (S n)) -> p n) =>
fun (n:nat) (H2:G f n) =>
match H2 with
| mkG _ _ H3 => _
end
).
However, Coq will not allow me to carry out the pattern match due to the elim restriction.
The book informally says "Checking that the defining equation of elimG is well-typed is not difficult"
I am posting this in the hope that someone familiar with the book will have an opinion as to whether the author made a mistake, or whether I am missing something.
EDIT:
Having played around with the two answers below, the simplest term expression I have come up with is as follows:
Definition elimG
(f:nat -> bool)
(p:nat -> Type)
(g: forall (n:nat), (f n = false -> p (S n)) -> p n)
: forall (n:nat), G f n -> p n
:= fix k (n:nat) (H:G f n) : p n := g n
(fun e => k (S n)
( match H with
| mkG _ _ H => H
end e)).
This definition is possible, there's just a subtlety here. The G (which is in Prop) is never needed to make a decision here, because it only has one constructor. So you just do the
elimG f p g n h := g n (λe. elimG f p g (S n) _)
"unconditionally" outside of any match on h. That hole now has expected type G f (S n), which now is in Prop, and we can do our match on h there. We also have to do some rewriting shenanigans with the match. Putting everything together, we write
Fixpoint elimG
(f : nat -> bool) (p : nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n : nat) (H : G f n) {struct H}
: p n :=
g n
(fun e =>
elimG f p g (S n)
(match H in G _ n return f n = false -> G f (S n) with (* in and return clause can be inferred; we're rewriting the n in e's type *)
| mkG _ _ H => H
end e)).
That's a tricky one.
The author is not wrong, it is possible to define such an elimination principle but you have to be careful about how and when you match on your hypothesis.
The error that you get from Coq is that you are matching on a proposition to build an element of a Type. Coq forbid this so that proposition can be erased when extracting code, so you cannot do such a case-analysis of a proposition to build some computationally meaningful object (there are exceptions to this rule for instance for empty propositions).
Since you cannot start by pattern matching on H2, you can try to push this case-analysis as late as possible. Here you only need to do the case analysis in the application (h e) so you could replace it by match H2 with mkG _ n' h -> h e end.
However this does not work because h is of type f' n' = false -> ... whereas e : f n = false and you need to explain to Coq that n and n' are the same. This is achieved through dependent pattern matching, putting the apllication outside of the match and using a return clause in the script below (actually Coq can infer this return clause, I'm just leaving it for explanations).
Inductive G (f:nat -> bool) : nat -> Prop :=
| mkG : forall (n:nat), (f n = false -> G f (S n)) -> G f n
.
Fixpoint elimG (f:nat -> bool) (p:nat -> Type)
(g : forall (n:nat), (f n = false -> p (S n)) -> p n)
(n:nat) (H : G f n) {struct H} : p n.
Proof.
refine (g n (fun e => elimG f p g (S n) _)).
refine (match H in G _ n0 return f n0 = false -> G f (S n0) with mkG _ _ h => h end e).
Qed.
What is the best way to rewrite \sum_(i...) (F i - G i) as (\sum_(i...) F i - \sum_(i...) G i) on ordinals with bigop, assuming that underflows are properly managed?
More precisely, regarding these underflows, I'm interested in the following lemma:
Lemma big_split_subn (n : nat) (P : 'I_n -> bool) (F G : 'I_n -> nat) :
(forall i : 'I_n, P i -> G i <= F i) ->
\sum_(i < n | P i) (F i - G i) = \sum_(i < n | P i) F i - \sum_(i < n | P i) G i.
It seems that big_split should work for an addition (or subtraction in Z, using big_distrl with -1), but I need to use it for a subtraction on (bounded) naturals.
Thanks in advance for any suggestion.
Bye,
Pierre
Here is a shorter proof with a more general statement, I will add it to the library.
Lemma sumnB I r (P : pred I) (E1 E2 : I -> nat) :
(forall i, P i -> E1 i <= E2 i) ->
\sum_(i <- r | P i) (E2 i - E1 i) =
\sum_(i <- r | P i) E2 i - \sum_(i <- r | P i) E1 i.
Proof. by move=> /(_ _ _)/subnK-/(eq_bigr _)<-; rewrite big_split addnK. Qed.
EDIT: actually, there was even a one liner.
Here is the explanation for the intro pattern, starting with move=>
/(_ _ _) fills the two arguments of the hypothesis forall i, P i -> E1 i <= E2 i) with two meta-variables (let's name the first ?i),
then /subnK chains it to turn the comparison into E2 ?i - E1 ?i + E1 ?i = E2 ?i.
- discharges the meta-variables, turning the top hypothesis into forall i, P i -> E2 i - E1 i + E1 i = E2 i
/(eq_bigr _)<- chains with the congruence lemma, using _ as a first
arguments (which is supposed to be the shape of the right hand side which
we do not want to provide), this leads to the hypothesis
forall idx op P l, \big[op/idx]_(i <- l | P i) (E2 i - E1 i + E1 i) = \big[op/idx]_(i <- l | P i) E2 i) which we can use to rewrite right to
left using <-.
We conclude with the usual big_split and cancel with addnK.
Here is a nice answer written by Emilio Gallego Arias (user:1955696) (thanks, Emilio).
Lemma big_split_subn (P : 'I_k -> bool) F1 F2
(H : forall s : 'I_k, P s -> F2 s <= F1 s) :
\sum_(s < k | P s) (F1 s - F2 s) =
\sum_(s < k | P s) F1 s - \sum_(s < k | P s) F2 s.
Proof.
suff:
\sum_(s < k | P s) (F1 s - F2 s) =
\sum_(s < k | P s) F1 s - \sum_(s < k | P s) F2 s /\
\sum_(s < k | P s) F2 s <= \sum_(s < k | P s) F1 s by case.
pose K x y z := x = y - z /\ z <= y.
apply: (big_rec3 K); first by []; rewrite {}/K.
move=> i b_x b_y b_z /H Pi [] -> Hz; split; last exact: leq_add.
by rewrite addnBA ?addnBAC ?subnDA.
Qed.
If I correctly parse your question, you focus on the following equality:
forall (n : nat) (F G : 'I_n -> nat),
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Obviously, given the behavior of the truncated subtraction (_ - _)%N, this statement doesn't hold as is, we need an hypothesis saying that no (F i - G i) cancels, in order to prove the equality.
Hence the following statement:
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat fintype bigop.
Lemma question (n : nat) (F G : 'I_n -> nat) :
(forall i : 'I_n, G i <= F i) ->
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Then you're right that big_split is not applicable as is, and moreover starting over from the proof of big_split can't be successful, as we get:
Proof.
move=> Hmain.
elim/big_rec3: _ => [//|i x y z _ ->].
(* 1 subgoal
n : nat
F, G : 'I_n -> nat
Hmain : forall i : 'I_n, G i <= F i
i : ordinal_finType n
x, y, z : nat
============================
F i - G i + (y - x) = F i + y - (G i + x)
*)
and we are stuck because there is no hypothesis on (y - x).
However, it is possible to prove the lemma by relying on a "manual induction", combined with the following lemmas:
Check big_ord_recl.
(*
big_ord_recl :
forall (R : Type) (idx : R) (op : R -> R -> R) (n : nat) (F : 'I_n.+1 -> R),
\big[op/idx]_(i < n.+1) F i =
op (F ord0) (\big[op/idx]_(i < n) F (lift ord0 i))
*)
Search _ addn subn in ssrnat.
(see also https://github.com/math-comp/math-comp/wiki/Search)
In particular, here is a possible proof of that result:
Lemma question (n : nat) (F G : 'I_n -> nat) :
(forall i : 'I_n, G i <= F i) ->
\sum_(i < n) (F i - G i) = \sum_(i < n) F i - \sum_(i < n) G i.
Proof.
elim: n F G => [|n IHn] F G Hmain; first by rewrite !big_ord0.
rewrite !big_ord_recl IHn // addnBAC // subnDA //.
rewrite -subnDA [in X in _ = _ - X]addnC subnDA.
congr subn; rewrite addnBA //.
exact: leq_sum.
Qed.
EDIT: the generalization could indeed be done using this lemma:
reindex
: forall (R : Type) (idx : R) (op : Monoid.com_law idx) (I J : finType)
(h : J -> I) (P : pred I) (F : I -> R),
{on [pred i | P i], bijective h} ->
\big[op/idx]_(i | P i) F i = \big[op/idx]_(j | P (h j)) F (h j)
however it appears not as straightforward as I expected: FYI below is an almost-complete script − where the two remaining admits deal with the bijection property of the reindexation functions, hoping that this helps (also it seems a few lemmas, such asmem_enumT and filter_predI, might be added in MathComp, so I'll probably open a PR to propose that):
From mathcomp Require Import all_ssreflect.
Lemma mem_enumT (T : finType) (x : T) : (x \in enum T).
Proof. by rewrite enumT mem_index_enum. Qed.
Lemma predII T (P : pred T) :
predI P P =1 P.
Proof. by move=> x; rewrite /predI /= andbb. Qed.
Lemma filter_predI T (s : seq T) (P1 P2 : pred T) :
filter P1 (filter P2 s) = filter (predI P1 P2) s.
Proof.
elim: s => [//|x s IHs] /=.
case: (P2 x); rewrite ?andbT /=.
{ by rewrite IHs. }
by case: (P1 x) =>/=; rewrite IHs.
Qed.
Lemma nth_filter_enum
(I : finType) (P : pred I) (s := filter P (enum I)) (j : 'I_(size s)) x0 :
P (nth x0 [seq x <- enum I | P x] j).
Proof.
suff: P (nth x0 s j) && (nth x0 s j \in s) by case/andP.
rewrite -mem_filter /s /= filter_predI.
under [filter (predI P P) _]eq_filter do rewrite predII. (* needs Coq 8.10+ *)
exact: mem_nth.
Qed.
Lemma big_split_subn (n : nat) (P : 'I_n -> bool) (F G : 'I_n -> nat) :
(forall i : 'I_n, P i -> G i <= F i) ->
\sum_(i < n | P i) (F i - G i) =
\sum_(i < n | P i) F i - \sum_(i < n | P i) G i.
Proof.
move=> Hmain.
(* Prepare the reindexation on the indices satisfying the pred. P *)
set s := filter P (enum 'I_n).
set t := in_tuple s.
(* We need to exclude the case where the sums are empty *)
case Es: s => [|x0 s'].
{ suff Hpred0: forall i : 'I_n, P i = false by rewrite !big_pred0 //.
move: Es; rewrite /s; move/eqP.
rewrite -[_ == [::]]negbK -has_filter => /hasPn HP i.
move/(_ i) in HP.
apply: negbTE; apply: HP; exact: mem_enumT.
}
(* Coercions to go back and forth betwen 'I_(size s) and 'I_(size s).-1.+1 *)
have Hsize1 : (size s).-1.+1 = size s by rewrite Es.
have Hsize2 : size s = (size s).-1.+1 by rewrite Es.
pose cast1 i := ecast n 'I_n Hsize1 i.
pose cast2 i := ecast n 'I_n Hsize2 i.
set inj := fun (i : 'I_(size s).-1.+1) => tnth t (cast1 i).
have Hinj1 : forall i : 'I_(size s).-1.+1, P (inj i).
{ move=> j.
rewrite /inj (tnth_nth (tnth t (cast1 j)) t (cast1 j)) /t /s in_tupleE /=.
exact: nth_filter_enum. }
have Hinj : {on [pred i | P i], bijective inj}.
{ (* example inverse function; not the only possible definition *)
pose inj' :=
(fun n : 'I_n => if ~~ P n then #ord0 (size s).-1 (* dummy value *)
else #inord (size s).-1 (index n (filter P s))).
exists inj'; move=> x Hx; rewrite /inj /inj'.
admit. admit. (* exercise left to the reader :) *)
}
(* Perform the reindexation *)
rewrite !(reindex inj).
do ![under [\sum_(_ | P _) _]eq_bigl do rewrite Hinj1]. (* needs Coq 8.10+ *)
apply: question => i; exact: Hmain.
all: exact: Hinj.
Admitted.
The main problem is I cannot define such an Inductive proposition:
Inductive forces : nat -> Prop :=
| KM_cond (n : nat) : ~ forces 0 ->
forces n.
In fact, I am trying to define the Kripke Semantics for Intuitionistic Logic
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (~ forces M y A \/ forces M y B)) ->
forces M x (A then B).
but I get the following error
Non strictly positive occurrence of "forces"
If I just remove the negation, the problem goes away
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A \/ forces M y B)) ->
forces M x (A then B).
but the problem exists with -> also
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A -> forces M y B)) ->
forces M x (A then B).
I cannot understand what would possibly go wrong if I define this Inductive thing, and I cannot think of any other way to achieve this definition.
UPDATE:
These are the needed definitions:
From Coq Require Import Lists.List.
From Coq Require Import Lists.ListSet.
From Coq Require Import Relations.
Import ListNotations.
Definition var := nat.
Inductive prop : Type :=
| bot
| atom (p : var)
| conj (A B : prop)
| disj (A B : prop)
| cond (A B : prop).
Notation "A 'and' B" := (conj A B) (at level 50, left associativity).
Notation "A 'or' B" := (disj A B) (at level 50, left associativity).
Notation "A 'then' B" := (cond A B) (at level 60, no associativity).
Definition world := nat.
Definition preorder {X : Type} (R : relation X) : Prop :=
(forall x : X, R x x) /\ (forall x y z : X, R x y -> R y z -> R x z).
Inductive Kripke_model : Type :=
| Kripke (W : set world) (R : relation world) (v : var -> world -> bool)
(HW : W <> empty_set world)
(HR : preorder R)
(Hv : forall x y p, In x W -> In y W ->
R x y -> (v p x) = true -> (v p y) = true).
Definition worlds (M : Kripke_model) :=
match M with
| Kripke W _ _ _ _ _ => W
end.
Definition rel (M : Kripke_model) :=
match M with
| Kripke _ R _ _ _ _ => R
end.
Definition val (M : Kripke_model) :=
match M with
| Kripke _ _ v _ _ _ => v
end.
You cannot define this relation as an inductive predicate, but you can define it by recursion on the formula:
Fixpoint forces (M : Kripke_model) (x : world) (p : prop) : Prop :=
match p with
| bot => False
| atom p => val M p x = true
| conj p q => forces M x p /\ forces M x q
| disj p q => forces M x p \/ forces M x q
| cond p q => forall y, rel M x y -> forces M y p -> forces M y q
end.
This trick does not work if the definition is not well-founded with respect to the formula structure, but it might be enough for your use case.
I am trying to prove that given
(eqX : relation X) (Hypo : Equivalence eqX) (f : X -> {x : X | P x})
then
eqX a b -> eqX (proj1_sig (f a)) (proj1_sig (f b))
The function f get a parameter of Type X and give an existing assertion {x : X | P x}. ( for example fun (n : nat) => {m : nat | S m = n} )
In one word, I would like to show that given two parameters which are equivalent under the equivalent relation eqX, then the destruct result of existing assertion {x : X | P x} is also of the same equivalence class.
Can I prove this goal directly(which means the Specif.sig hold this property), or I should prove or claim that f satisfy some constraint and after which can I get this assertion proven.
Your claim is not directly provable; consider
X := nat
eqX a b := (a mod 2) = (b mod 2)
P a := True
f x := exist P (x / 2) I
Then we have eqX 2 4 but we don't have eqX (proj1_sig (f 2)) (proj1_sig (f 4)) because we don't have eqX 1 2.
You can either take in the theorem you are trying to prove as a hypothesis, or you can take in a hypothesis of type forall a, proj1_sig (f a) = a, or you can take in a hypothesis of type forall a, eqX (proj1_sig (f a)) a. Note that all of these are provable (by reflexivity or intros; assumption) if you have f a := exist P a (g a) for some function g.
Is this what you are trying to show?
Require Import Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.Equivalence.
Require Import Setoid.
Generalizable All Variables.
Lemma foo `{!#Equivalence A RA, #Equivalence B RB, f : #respecting A _ _ B _ _ , #equiv A _ _ a b} :
equiv (proj1_sig f a) (proj1_sig f b).
Proof.
now apply respecting_equiv.
Qed.