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

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

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.

How can I construct terms in first-order logic using Coq?

I'm trying to define first-order logic in Coq and beginning at terms.
Supposing that c1 and c2 are two constant symbols, variables are nat and f1 and f2 are two function symbols whose arities are 1 and 2 respectively, I wrote the following code.
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| F1 : term -> term
| F2 : term -> term -> term.
Then, I got a desired induction.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall t : term, P t -> P (F1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P (F2 t t0)) ->
forall t : term, P t *)
Then I wanted to separate functions from the definition of term, so I rewrote the above.
(*Idea A*)
Inductive funct {X : Type} : Type :=
| f1 : X -> funct
| f2 : X -> X -> funct.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : #funct term -> term.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind term.
(* ==> funct_ind term
: forall P : funct -> Prop,
(forall x : term, P (f1 x)) ->
(forall x x0 : term, P (f2 x x0)) ->
forall f1 : funct, P f1 *)
(*Idea B*)
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Check term_ind.
(* ==> term_ind
: forall P : term -> Prop,
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P (Fun f1)) ->
forall t : term, P t *)
Check funct_ind.
(* ==> funct_ind
: forall P : funct -> Prop,
(forall t : term, P (f1 t)) ->
(forall t t0 : term, P (f2 t t0)) ->
forall f1 : funct, P f1 *)
However, both ways seem not to generate the desired induction because they don't have induction hypotheses.
How can I construct term with functions separated from the definition of term without loss of proper induction?
Thanks.
This is a common issue with Coq: the induction principles generated for mutually inductive types and for types with complex recursive occurrences are too weak. Fortunately, this can be fixed by defining the induction principles by hand. In your case, the simplest approach is to use the mutually inductive definition, since Coq can lend us a hand for proving the principle.
First, let ask Coq not to generate its weak default induction principle:
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct -> term
with funct : Type :=
| f1 : term -> funct
| f2 : term -> term -> funct.
Set Elimination Schemes.
(This is not strictly necessary, but it helps keeping the global namespace clean.)
Now, let us use the Scheme command to generate a mutual induction principle for these types:
Scheme term_ind' := Induction for term Sort Prop
with funct_ind' := Induction for funct Sort Prop.
(*
term_ind'
: forall (P : term -> Prop) (P0 : funct -> Prop),
(forall c : const, P (Con c)) ->
(forall v : var, P (Var v)) ->
(forall f1 : funct, P0 f1 -> P (Fun f1)) ->
(forall t : term, P t -> P0 (f1 t)) ->
(forall t : term, P t -> forall t0 : term, P t0 -> P0 (f2 t t0)) ->
forall t : term, P t
*)
This principle is already powerful enough for us to prove properties of term, but it is a bit awkward to use, since it requires us to specify a property that we want to prove about the funct type as well (the P0 predicate). We can simplify it a bit to avoid mentioning this auxiliary predicate: all we need to know is that the terms inside the function calls satisfy the predicate that we want to prove.
Definition lift_pred (P : term -> Prop) (f : funct) : Prop :=
match f with
| f1 t => P t
| f2 t1 t2 => P t1 /\ P t2
end.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall f, lift_pred P f -> P (Fun f)) ->
forall t, P t.
Proof.
intros HCon HVar HFun.
apply (term_ind' P (lift_pred P)); trivial.
now intros t1 IH1 t2 IH2; split.
Qed.
If you prefer, you can also rewrite this to look more like the original induction principle:
Reset term_ind.
Lemma term_ind (P : term -> Prop) :
(forall c, P (Con c)) ->
(forall v, P (Var v)) ->
(forall t, P t -> P (Fun (f1 t))) ->
(forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) ->
forall t, P t.
Proof.
intros HCon HVar HFun_f1 HFun_f2.
apply (term_ind' P (lift_pred P)); trivial.
- now intros [t|t1 t2]; simpl; intuition.
- now simpl; intuition.
Qed.
Edit
To get an induction principle for your other approach, you have to write a proof term by hand:
Definition var := nat.
Inductive const : Type :=
| c1
| c2.
Inductive funct (X : Type) : Type :=
| f1 : X -> funct X
| f2 : X -> X -> funct X.
Arguments f1 {X} _.
Arguments f2 {X} _ _.
Unset Elimination Schemes.
Inductive term : Type :=
| Con : const -> term
| Var : var -> term
| Fun : funct term -> term.
Set Elimination Schemes.
Definition term_ind (P : term -> Type)
(HCon : forall c, P (Con c))
(HVar : forall v, P (Var v))
(HF1 : forall t, P t -> P (Fun (f1 t)))
(HF2 : forall t1, P t1 -> forall t2, P t2 -> P (Fun (f2 t1 t2))) :
forall t, P t :=
fix loop (t : term) : P t :=
match t with
| Con c => HCon c
| Var v => HVar v
| Fun (f1 t) => HF1 t (loop t)
| Fun (f2 t1 t2) => HF2 t1 (loop t1) t2 (loop t2)
end.

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.

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.

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.