I am following the book Computational Type Theory and Interactive Theorem Proving with Coq, and
one of the exercises is for me to write of term of type:
forall (p:bool -> Prop) (x:bool), (x = true -> p true) -> (x = false -> p false) -> p x
I tried the obvious:
Fail Definition L7 : forall (p:bool -> Prop) (x:bool), (x = true -> p true) -> (x = false -> p false) -> p x :=
fun (p:bool -> Prop) =>
fun (x:bool) =>
fun (tt:x = true -> p true) =>
fun (ff:x = false -> p false) =>
match x with
| true => tt (eq_refl true)
| false => ff (eq_refl false)
end.
and the less obvious:
Definition bool_dec : forall (x:bool), x = true \/ x = false :=
fun (x:bool) =>
match x with
| true => or_introl (eq_refl true)
| false => or_intror (eq_refl false)
end.
Fail Definition L8 : forall (p:bool -> Prop) (x:bool), (x = true -> p true) -> (x = false -> p false) -> p x :=
fun (p:bool -> Prop) =>
fun (x:bool) =>
fun (tt:x = true -> p true) =>
fun (ff:x = false -> p false) =>
match bool_dec x with
| or_introl p => tt p
| or_intror p => ff p
end.
I know there is going to be a trick match ... in ... return ... or some convoy pattern business, leading to a duh moment on my part, but I have been spending an hour on this and would like to move on. Can anyone take me out of my misery?
First, you can use keyword fun just once in nested function like this
fun (p:bool -> Prop)
(x:bool)
(tt:x = true -> p true)
(ff:x = false -> p false) =>
match x with
| true => tt (eq_refl true)
| false => ff (eq_refl false)
end.
Now, a good way would be use tactics to generate a proof (an object of this type), then use Print to see what is the object.
Theorem L7 : forall (p:bool -> Prop) (x:bool), (x = true -> p true) -> (x = false -> p false) -> p x.
Proof.
intros. destruct x.
- apply H. reflexivity.
- apply H0. reflexivity.
Qed.
Print L7.
The output would be
L7 =
fun (p : bool -> Prop)
(x : bool)
(H : x = true -> p true)
(H0 : x = false -> p false)
=>
(if x as b
return
((b = true -> p true) ->
(b = false -> p false) ->
p b)
then
fun
(H1 : true = true -> p true)
(_ : true = false ->
p false) =>
H1 eq_refl
else
fun
(_ : false = true -> p true)
(H2 : false = false ->
p false) =>
H2 eq_refl) H H0
: forall
(p : bool -> Prop)
(x : bool),
(x = true -> p true) ->
(x = false -> p false) ->
p x
Arguments L7 _%function_scope
_%bool_scope (_
_)%function_scope
Thanks to Kamyar above, I was able to obtain a simple solution:
Definition L8 : forall (p:bool -> Prop) (x:bool), (x = true -> p true) -> (x = false -> p false) -> p x :=
fun (p:bool -> Prop) (x:bool) (H1:x = true -> p true) (H2:x = false -> p false) =>
match x as b return x = b -> p b with
| true => H1
| false => H2
end (eq_refl x).
Related
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.
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.
In my program, I use List.filter to search a list for finding specific elements. I am proving if List.filter finds some elements in a list, then by appenindg another list we still get those elements that were in the first list before appending. I am a bit stuck in provingfilterKeepSameElementsAfterAppending. To make my program shorter, I changed my program's data to customType and mydata.
Require Import List Nat.
Inductive customType : Type :=
|Const1: nat -> customType
|Const2: list nat -> customType.
Inductive mydata : Set :=
|Set1: customType * customType ->mydata
|Set2: customType ->mydata.
Fixpoint custome_Equal (c1 c2:customType) :bool:=
match c1 with
|Const1 nt => match c2 with
|Const1 mt => eqb nt mt
|Const2 (hm::lmt) => eqb nt hm
| _ => false
end
|Const2 (hn::lnt) => match c2 with
|Const1 mt => eqb hn mt
|Const2 (hm:: lmt) => eqb hn hm
| _ => false
end
| _ => false
end.
Fixpoint Search (l: mydata) (t:customType): bool :=
match l with
|Set1 (a1, a2) => if (custome_Equal a2 t) then true else false
| _=>false
end.
Lemma filterKeepSameElementsAfterAppending(l1 l2: list mydata)(x:mydata)(ta:customType):
In x (filter (fun n => Search n ta) (l1)) -> In x (filter (fun n => Search n ta) (l2++ l1)).
Proof.
intro.
The filter_cat lemma should provide you some inspiration:
filter_cat
forall (T : Type) (a : pred T) (s1 s2 : seq T),
[seq x <- s1 ++ s2 | a x] = [seq x <- s1 | a x] ++ [seq x <- s2 | a x]
together with mem_cat should do what you want:
mem_cat
forall (T : eqType) (x : T) (s1 s2 : seq T),
(x \in s1 ++ s2) = (x \in s1) || (x \in s2)
Complete code:
From mathcomp Require Import all_ssreflect.
Lemma mem_filter_cat (T : eqType) p (l1 l2 : seq T) x :
x \in filter p l1 -> x \in filter p (l1 ++ l2).
Proof. by rewrite filter_cat mem_cat => ->. Qed.
With dependent types, it's possible to define an inductive type for sorted lists, e.g.:
data IsSorted : {a: Type} -> (ltRel: (a -> a -> Type)) -> List a -> Type where
IsSortedZero : IsSorted {a=a} ltRel Nil
IsSortedOne : (x: a) -> IsSorted ltRel [x]
IsSortedMany : (x: a) -> (y: a) -> .IsSorted rel (y::ys) -> .(rel x y) -> IsSorted rel (x::y::ys)
This can then be used to reason about sorted lists.
In Coq, one could also write a function Fixpoint is_sorted: {A: Type} (l: List A) : bool, and then make use of a type like is_sorted someList = true to prove things, by unfolding the definition of is_sorted. Is this latter approach possible in Idris, or does it only support the former approach?
Furthermore, for my own understanding: is the latter case an example of "proof by reflection", and is there any situation in which the latter approach would be preferable to the former?
I think the following partially does what you want (I will add the caveat that I have no experience of using Coq):
infixl 4 &
(&) : Bool -> Bool -> Bool
(&) True True = True
(&) _ _ = False
elim_and : x & y = True -> (x = True, y = True)
elim_and {x = False} {y = False} x_and_y_is_true = (x_and_y_is_true, x_and_y_is_true)
elim_and {x = False} {y = True} x_and_y_is_true = (x_and_y_is_true, Refl)
elim_and {x = True} {y = False} x_and_y_is_true = (Refl, x_and_y_is_true)
elim_and {x = True} {y = True} x_and_y_is_true = (Refl, Refl)
is_sorted : {a: Type} -> (ltRel: a -> a -> Bool) -> List a -> Bool
is_sorted ltRel [] = True
is_sorted ltRel (x :: []) = True
is_sorted ltRel (x :: y :: xs) = (ltRel x y) & (is_sorted ltRel (y :: xs))
is_sorted_true_elim : {x : a} -> is_sorted ltRel (x :: y :: xs) = True -> (ltRel x y = True,
is_sorted ltRel (y :: xs) = True)
is_sorted_true_elim {x} {y} {xs} {ltRel} is_sorted_x_y_xs = elim_and is_sorted_x_y_xs
The important detail is that if your function definition is a simple set of equations, then the unification will somewhat magically substitute one side of the equation for the other when required. (I used a less efficient non-shortcircuited version of the logical "and" operator, because the standard "&&" or "if/then/else" operators introduce complications of laziness.)
Ideally there should be some straightforward way to unfold definitions that include 'with'-based pattern matching, but I don't know how to make that work, eg:
is_sorted : {a: Type} -> (ltRel: a -> a -> Bool) -> List a -> Bool
is_sorted ltRel [] = True
is_sorted ltRel (x :: []) = True
is_sorted ltRel (x :: y :: xs) with (ltRel x y)
| True = is_sorted ltRel (y :: xs)
| False = False
is_sorted_true_elim : {x : a} -> is_sorted ltRel (x :: y :: xs) = True -> (ltRel x y = True,
is_sorted ltRel (y :: xs) = True)
is_sorted_true_elim {x} {y} {xs} {ltRel} is_sorted_x_y_xs with (ltRel x y) proof x_lt_y_value
| True = ?hole
| False = ?hole2
I have the following definition for terms :
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Require Import Coq.Strings.String.
Import ListNotations.
Definition VarIndex:Type := nat.
Inductive Term : Type :=
|Var : VarIndex -> Term
|Comb: string -> (list Term) -> Term.
(*compare two list *)
Fixpoint beq_list {X:Type} (l l' :list X) (EqX :X -> X -> bool): bool :=
match l with
| [] => match l' with
| [] => true
| a => false
end
| (x::xs) =>
match l' with
|[] => false
|(y::ys) => if (EqX x y) then beq_list xs ys EqX else false
end
end.
Fixpoint length {X : Type} (l : list X) : nat :=
match l with
| nil => 0
| cons _ l' => S (length l')
end.
and a function beq_term to compare two terms define as follow :
Fixpoint beq_term (t1:Term) (t2:Term) : bool :=
match t1, t2 with
| Var i, Var j => beq_nat i j
| Var _, Comb _ _ => false
|Comb _ _, Var _ => false
|(Comb s1 ts1), Comb s2 ts2 => if(beq_nat (length ts1) (length ts2))
then beq_list ts1 ts2 beq_term
else false
end.
The definition of the function beq_term yields the error message:
Error: Cannot guess decreasing argument of fix.
So I am interested in how to convince Coq of the termination.
If you want to be able to use Coq's syntactic check in this simple example in particular, it is enough to write beq_list and beq_term into a single function.
Fixpoint beq_list (l l' :list Term) : bool :=
match l, l' with
| [], [] => true
| (Var i)::xs, (Var j)::ys => beq_nat i j && beq_list xs ys
| (Comb s1 ts1)::xs, (Comb s2 ts2)::ys => beq_list xs ys
| _,_ => false
end.