Non strictly positive occurrence problem in Coq inductive definition - coq

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.

Related

Can I define an equivalent to this using the Axiom command?

mu can not be defined.
Definiton mu (A : Type) (f : A -> A) : A := f (mu A f).
However, the Axiom command can be used to pseudo-define mu.
Axiom mu : forall A : Type, (A -> A) -> A.
Axiom mu_beta : forall (A : Type) (f : A -> A), mu A f = f (mu A f).
Can I do the same for higher_path and higher_path_argument? Even after using several techniques, it still seems to be impossible.
Definition higher_path
: forall n : nat, higher_path_argument n -> Type
:= fun n : nat =>
match n with
| O => fun x : higher_path_argument 0 => x
| S n_p =>
fun x : higher_path_argument (S n_p) =>
match x with
| existT _ x_a x_b =>
match x_b with
| pair x_b_a x_b_b => x_b_a = x_b_b :> higher_path n_p x_a
end
end
end.
Definition higher_path_argument
: nat -> Type
:= fun n : nat =>
match n with
| O => Type
| S n_p =>
sigT
(A := higher_path_argument n_p)
(fun x_p => prod (higher_path n_p x_p) (higher_path n_p x_p))
end.
You will have to start with
Axiom higher_path_argument : nat -> Type.
Axiom higher_path : forall n : nat, higher_path_argument n -> Type.
then higher_path_argument_beta which you will have to use in the higher_path_beta to compute the type. You will however end up with something really verbose however.

Can't bind variable to wrapped open formula

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)).

Coq: induction principles for void, unit and bool from nat and fin

I can define finite types in Coq like this:
Inductive fin : nat -> Set :=
| FZ : forall {n}, fin (S n)
| FS : forall {n}, fin n -> fin (S n).
Definition void := fin 0.
Definition unit := fin 1.
Definition vunit : unit := FZ.
Definition bool := fin 2.
Definition true : bool := FZ.
Definition false : bool := FS FZ.
Can I proof the induction principles for void, unit and bool just from the induction principles of nat and fin?
I have proven the induction principle for void already:
Lemma void_ind : forall (P : void -> Prop) (x : void), P x.
Proof.
intros.
inversion x.
Qed.
But I don't know how to proceed with unit:
Lemma unit_ind : forall (P : unit -> Prop) (x : unit), P vunit -> P x.
I figure I need:
Lemma unit_uniq : forall (x : fin 1), x = FZ.
And in my head this seems obvious, but I don't know how to proceed with the proof.
After that I also like to prove:
Lemma bool_ind : forall (P : bool -> Prop) (x : bool), P true -> P false -> P x.
There are many ways of deriving these induction principles. Since you asked
explicitly about using the induction principles for fin and nat, I am going
to use those. Actually, since all the derived types are finite, we can get away
with just using a case analysis principle, which we can define in terms of
induction. Here is how we define case analysis for the natural numbers. (I am
putting the Type valued recursor here, since we'll need the extra generality.)
Definition nat_case :
forall (P : nat -> Type),
P 0 ->
(forall n, P (S n)) ->
forall n, P n :=
fun P HZ HS => nat_rect P HZ (fun n _ => HS n).
We can define an analogous principle for fin. But to make it more useful, we
add a little twist. The original recursor for fin is parameterized over a
predicate P : forall n, fin n -> Prop that must work for fins of an
arbitrary upper bound. We'll use nat_case so that we can fix the upper bound
we use (cf. the types of P below).
Inductive fin : nat -> Set :=
| FZ : forall {n}, fin (S n)
| FS : forall {n}, fin n -> fin (S n).
Definition fin_case_result n : fin n -> Type :=
nat_case (fun n => fin n -> Type)
(fun x : fin 0 =>
forall (P : fin 0 -> Type), P x)
(fun m (x : fin (S m)) =>
forall (P : fin (S m) -> Type),
P FZ ->
(forall y, P (FS y)) ->
P x)
n.
Definition fin_case :
forall n (x : fin n), fin_case_result n x :=
fun n x =>
fin_rect fin_case_result
( (* FZ case *)
fun m P HZ HS => HZ)
( (* FS case.
The blank is the result of the recursive call. *)
fun m (y : fin m) _ P HZ HS => HS y)
n x.
Thanks to fin_case, we can define the induction principles you wanted:
Definition void := fin 0.
Definition unit := fin 1.
Definition vunit : unit := FZ.
Definition bool := fin 2.
Definition true : bool := FZ.
Definition false : bool := FS FZ.
Definition void_ind :
forall (P : void -> Prop)
(x : void),
P x :=
fun P x => fin_case 0 x P.
Definition unit_ind :
forall (P : unit -> Prop)
(HZ : P vunit)
(x : unit),
P x :=
fun P HZ x =>
fin_case 1 x P HZ (void_ind (fun y => P (FS y))).
Definition bool_ind :
forall (P : bool -> Prop)
(HT : P true)
(HF : P false)
(x : bool),
P x :=
fun P HT HF x =>
fin_case 2 x P HT (unit_ind (fun y => P (FS y)) HF).

Issue around the 'elim restriction'

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.

Ltac-tically abstracting over a subterm of the goal type

As a rough and untutored background, in HoTT, one deduces the heck out of the inductively defined type
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
which allows the very general construction
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
The Lemma transport would be at the heart of HoTT "replace" or "rewrite" tactics; the trick, so far as I understand it, would be, supposing a goal which you or I can abstractly recognize as
...
H : paths x y
[ Q : (G x) ]
_____________
(G y)
to figure out what is the necessary dependent type G, so that we can apply (transport G H). So far, all I've figured out is that
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b =>
match goal with
|- ?F b => apply (transport F γ)
| _ => idtac "apparently couldn't abstract" b "from the goal." end
| _ => idtac "Are you sure" γ "is a path?" end.
isn't general enough. That is, the first idtac gets used rather often.
The question is
[Is there a | what is the] Right Thing to Do?
There is a bug about using rewrite for relations in type, which would allow you to just say rewrite <- y.
In the mean time,
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b => pattern b; apply (transport _ y)
| _ => idtac "Are you sure" γ "is a path?"
end.
probably does what you want.
The feature request mentioned by Tom Prince in his answer has been granted:
Require Import Coq.Setoids.Setoid Coq.Classes.CMorphisms.
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
Global Instance paths_Reflexive {A} : Reflexive (#paths A) := idpath.
Global Instance paths_Symmetric {A} : Symmetric (#paths A).
Proof. intros ?? []; constructor. Defined.
Global Instance proper_paths {A} (x : A) : Proper paths x := idpath x.
Global Instance paths_subrelation
(A : Type) (R : crelation A)
{RR : Reflexive R}
: subrelation paths R.
Proof.
intros ?? p.
apply (transport _ p), RR.
Defined.
Global Instance reflexive_paths_dom_reflexive
{B} {R' : crelation B} {RR' : Reflexive R'}
{A : Type}
: Reflexive (#paths A ==> R')%signature.
Proof. intros ??? []; apply RR'. Defined.
Goal forall (x y : nat) G, paths x y -> G x -> G y.
intros x y G H Q.
rewrite <- H.
exact Q.
Qed.
I found the required instances by comparing the logs I got with Set Typeclasses Debug from setoid_rewrite <- H when H : paths x y and when H : eq x y.