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

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.

Related

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

Non strictly positive occurrence problem in Coq inductive definition

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.

Problems with dependent types in Coq proof assistant

Consider the following simple expression language:
Inductive Exp : Set :=
| EConst : nat -> Exp
| EVar : nat -> Exp
| EFun : nat -> list Exp -> Exp.
and its wellformedness predicate:
Definition Env := list nat.
Inductive WF (env : Env) : Exp -> Prop :=
| WFConst : forall n, WF env (EConst n)
| WFVar : forall n, In n env -> WF env (EVar n)
| WFFun : forall n es, In n env ->
Forall (WF env) es ->
WF env (EFun n es).
which basically states that every variable and function symbols must be defined in the environment. Now, I want to define a function that states the decidability of WF predicate:
Definition WFDec (env : Env) : forall e, {WF env e} + {~ WF env e}.
refine (fix wfdec e : {WF env e} + {~ WF env e} :=
match e as e' return e = e' -> {WF env e'} + {~ WF env e'} with
| EConst n => fun _ => left _ _
| EVar n => fun _ =>
match in_dec eq_nat_dec n env with
| left _ _ => left _ _
| right _ _ => right _ _
end
| EFun n es => fun _ =>
match in_dec eq_nat_dec n env with
| left _ _ => _
| right _ _ => right _ _
end
end (eq_refl e)) ; clear wfdec ; subst ; eauto.
The trouble is how to state that WF predicate holds or not for a list of expressions in the EFun case. My obvious guess was:
...
match Forall_dec (WF env) wfdec es with
...
But Coq refuses it, arguing that the recursive call wfdec is ill-formed. My question is: Is it possible to define decidability of such wellformedness predicate without changing the expression representation?
The complete working code is at the following gist.
The problem is that Forall_dec is defined as opaque in the standard library (that is, with Qed instead of Defined). Because of that, Coq does not know that the use of wfdec is valid.
The immediate solution to your problem is to redefine Forall_dec so that it is transparent. You can do this by printing the proof term that Coq generates and pasting it in your source file. I've added a gist here with a complete solution.
Needless to say, this approach lends itself to bloated, hard to read, and hard to maintain code. As ejgallego was pointing out in his answer, your best bet in this case is probably to define a Boolean function that decides WF, and use that instead of WFDec. The only problem with his approach, as he said, is that you will need to write your own induction principle to Exp in order to prove that the Boolean version indeed decides the inductive definition. Adam Chlipala's CPDT has a chapter on inductive types that gives an example of such an induction principle; just look for "nested inductive types".
As a temporal workaround you can define wf as:
Definition wf (env : Env) := fix wf (e : Exp) : bool :=
match e with
| EConst _ => true
| EVar v => v \in env
| EFun v l => [&& v \in env & all wf l]
end.
which is usually way more convenient to use. However, this definition will be pretty useless due to Coq generating the wrong induction principle for exp, as it doesn't detect the list. What I usually do is to fix the induction principle manually, but this is costly. Example:
From Coq Require Import List.
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Printing Implicit Defensive.
Import Prenex Implicits.
Section ReflectMorph.
Lemma and_MR P Q b c : reflect P b -> reflect Q c -> reflect (P /\ Q) (b && c).
Proof. by move=> h1 h2; apply: (iffP andP) => -[/h1 ? /h2 ?]. Qed.
Lemma or_MR P Q b c : reflect P b -> reflect Q c -> reflect (P \/ Q) (b || c).
Proof. by move=> h1 h2; apply: (iffP orP) => -[/h1|/h2]; auto. Qed.
End ReflectMorph.
Section IN.
Variables (X : eqType).
Lemma InP (x : X) l : reflect (In x l) (x \in l).
Proof.
elim: l => [|y l ihl]; first by constructor 2.
by apply: or_MR; rewrite // eq_sym; exact: eqP.
Qed.
End IN.
Section FORALL.
Variables (X : Type) (P : X -> Prop).
Variables (p : X -> bool).
Lemma Forall_inv x l : Forall P (x :: l) -> P x /\ Forall P l.
Proof. by move=> U; inversion U. Qed.
Lemma ForallP l : (forall x, In x l -> reflect (P x) (p x)) -> reflect (Forall P l) (all p l).
Proof.
elim: l => [|x l hp ihl /= ]; first by constructor.
have/hp {hp}hp : forall x : X, In x l -> reflect (P x) (p x).
by move=> y y_in; apply: ihl; right.
have {ihl} ihl := ihl _ (or_introl erefl).
by apply: (iffP andP) => [|/Forall_inv] [] /ihl hx /hp hall; constructor.
Qed.
End FORALL.
Inductive Exp : Type :=
| EConst : nat -> Exp
| EVar : nat -> Exp
| EFun : nat -> list Exp -> Exp.
Lemma Exp_rect_list (P : Exp -> Type) :
(forall n : nat, P (EConst n)) ->
(forall n : nat, P (EVar n)) ->
(forall (n : nat) (l : seq Exp), (forall x, In x l -> P x) -> P (EFun n l)) ->
forall e : Exp, P e.
Admitted.
Definition Env := list nat.
Definition wf (env : Env) := fix wf (e : Exp) : bool :=
match e with
| EConst _ => true
| EVar v => v \in env
| EFun v l => [&& v \in env & all wf l]
end.
Inductive WF (env : Env) : Exp -> Prop :=
| WFConst : forall n, WF env (EConst n)
| WFVar : forall n, In n env -> WF env (EVar n)
| WFFun : forall n es, In n env ->
Forall (WF env) es ->
WF env (EFun n es).
Lemma WF_inv env e (wf : WF env e ) :
match e with
| EConst n => True
| EVar n => In n env
| EFun n es => In n env /\ Forall (WF env) es
end.
Proof. by case: e wf => // [n|n l] H; inversion H. Qed.
Lemma wfP env e : reflect (WF env e) (wf env e).
Proof.
elim/Exp_rect_list: e => [n|n|n l ihe] /=; try repeat constructor.
by apply: (iffP idP) => [/InP|/WF_inv/InP //]; constructor.
apply: (iffP andP) => [[/InP ? /ForallP H]|/WF_inv[/InP ? /ForallP]].
by constructor => //; exact: H.
by auto.
Qed.

Different induction principles for Prop and Type

I noticed that Coq synthesizes different induction principles on equality for Prop and Type. Does anybody have an explanation for that?
Equality is defined as
Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x
And the associated induction principle has the following type:
eq_ind
: forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, x = y -> P y
Now let's define a Type pendant of eq:
Inductive eqT {A:Type}(x:A):A->Type:= eqT_refl: eqT x x.
The automatically generated induction principle is
eqT_ind
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Prop),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
Note: I'm going to use _rect principles everywhere instead of _ind, since _ind principles are usually implemented via the _rect ones.
Type of eqT_rect
Let's take a look at the predicate P.
When dealing with inductive families, the number of arguments of P is equal to the number of non-parametric arguments (indices) + 1.
Let me give some examples (they can be easily skipped).
Natural numbers don't have parameters at all:
Inductive nat : Set := O : nat | S : nat -> nat.
So, the predicate P will be of type nat -> Type.
Lists have one parametric argument (A):
Inductive list (A : Type) : Type :=
nil : list A | cons : A -> list A -> list A.
Again, P has only one argument: P : list A -> Type.
Vectors are a different:
Inductive vec (A : Type) : nat -> Type :=
nil : vec A 0
| cons : A -> forall n : nat, vec A n -> vec A (S n).
P has 2 arguments, because n in vec A n is a non-parameteric argument:
P : forall n : nat, vec A n -> Type
The above explains eqT_rect (and, of course, eqT_ind as a consequence), since the argument after (x : A) is non-parametric, P has 2 arguments:
P : forall a : A, eqT x a -> Type
which justifies the overall type for eqT_rect:
eqT_rect
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Type),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
The induction principle obtained in this way is called a maximal induction principle.
Type of eq_rect
The generated induction principles for inductive predicates (such as eq) are simplified to express proof irrelevance (the term for this is simplified induction principle).
When defining a predicate P, Coq simply drops the last argument of the predicate (which is the type being defined, and it lives in Prop). That's why the predicate used in eq_rect is unary. This fact shapes the type of eq_rect:
eq_rect :
forall (A : Type) (x : A) (P : A -> Type),
P x -> forall y : A, x = y -> P y
How to generate maximal induction principle
We can also make Coq generate non-simplified induction principle for eq:
Scheme eq_rect_max := Induction for eq Sort Type.
The resulting type is
eq_rect_max :
forall (A : Type) (x : A) (P : forall a : A, x = a -> Type),
P x eq_refl -> forall (y : A) (e : x = y), P y e
and it has the same structure as eqT_rect.
References
For more detailed explanation see sect. 14.1.3 ... 14.1.6 of the book "Interactive Theorem Proving and Program Development (Coq'Art: The Calculus of Inductive Constructions)" by Bertot and Castéran (2004).

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.