I have trees :
Inductive tree : Set :=
| Node : list tree -> tree.
and a collection of Definitions I'd like to use, all with a structure of the form :
Fixpoint getThemAll_aux (trees: list tree) (maxIter:nat): list tree :=
match maxIter with
| O => nil
| S n =>
match trees with
| nil => nil
| xx::rest => let newCandidates := generateCandidates xx in
let newRest := addAllIfDifferent tree eq_tree newCandidates rest in
addAllIfDifferent tree eq_tree newCandidates (getThemAll_aux newRest n)
end
end.
Definition getThemAll (seed:tree) : list tree :=
getThemAll_aux (seed::nil) 999.
Because of maxIter , this function is accepted whatever we have for generateCandidates of type tree -> list tree, eq_tree and addAllIfDifferent.
Now suppose that I have a proof that generateCandidates produces lists of trees with the same number of Nodes as the argument, and that eq_tree and addAllIfDifferent have the expected semantics.
Is that case, the function always terminates.
Is there then a way to get rid of the maxIter parameter, in the definition of the Fixpoint ?
The main problem of your definition is this 999.
If you are sure your function terminates, maybe you are capable
to write a function f that bounds the number of iterations you need.
so you can define
Definition getThemAll (seed:tree) : list tree :=
getThemAll_aux (seed::nil) (f seed).
and prove the theorem
forall trees,
getThemAll trees =
match trees with
| nil => nil
| xx::rest => let newCandidates := generateCandidates xx in
let newRest := addAllIfDifferent tree eq_tree newCandidates rest in
addAllIfDifferent tree eq_tree newCandidates (getThemAll newRest)
end.
Related
I got stuck on the exercise to prove my defined tree height is 3. I've found the binary tree coq code online, but the tree I defined is not a binary tree. The node contains arbitrary number.
tree pic attach:
Below is my code for the tree:
Inductive tree (X:Type) : Type :=
| empty : tree X
| branch : X -> list (tree X) -> tree X.
Arguments tree {X}.
Arguments empty {X}.
Arguments branch {X}.
Definition mytree :=
branch 1 [ branch 5 [ branch 2 [empty] ] ; branch 8 [empty] ;
branch 7 [ branch 3 [empty];branch 4 [empty] ] ].
Fixpoint height {X: Type} (node: #tree X) : nat :=
match node with
| empty => 0
| branch _ l => S (match l with
| [] => 0
| h::t => S (height h)
end)
end.
Below is the unit test. I tried to prove that my tree height is 3 (shown as pic)
Example test_height:
height mytree = 3.
Proof.
simpl.
after i simpl it, it showed: 6 = 3:
1 subgoal
______________________________________(1/1)
6 = 3
I guess is BC one or more functions that I defined previously are wrong. But I am not sure which one is it and why they are wrong?
Could anyone help or give me some hint? Thank you so much
PS: there's also a hint for the exercise stated:
Hint:
You may need to define mutually recursive functions using let expressions.
And it gives how let expression works as below:
• Naming a recursive function (needs keyword fix):
Definition a := let fix f (x:nat) := match x with
| O => O
| S y => f y
end
in f 2.
But I am not sure how to use this let in my exercise.
You've defined the height function incorrectly. You should define height by the pseudocode
height empty = 0
height (branch _ children) = 1 + max [height child | child in children]
where the max should return 0 if children is empty. Once you've defined the height function correctly, you should just be able to use reflexivity to prove the proposition.
Fixpoint height {X: Type} (t: tree X) : nat :=
match t with
| emp_tr _ => 0
| node_tr _ l => let fix height_list (ltrees: list (tree X)) :=
match ltrees with
| [] => 0
| htr :: ttr => max (height htr) (height_list ttr)
end
in 1 + height_list l
end.
Used let to solve.
Let's define two helper types:
Inductive AB : Set := A | B.
Inductive XY : Set := X | Y.
Then two other types that depend on XY and AB
Inductive Wrapped : AB -> XY -> Set :=
| W : forall (ab : AB) (xy : XY), Wrapped ab xy
| WW : forall (ab : AB), Wrapped ab (match ab with A => X | B => Y end)
.
Inductive Wrapper : XY -> Set :=
WrapW : forall (xy : XY), Wrapped A xy -> Wrapper xy.
Note the WW constructor – it can only be value of types Wrapped A X and Wrapped B Y.
Now I would like to pattern match on Wrapper Y:
Definition test (wr : Wrapper Y): nat :=
match wr with
| WrapW Y w =>
match w with
| W A Y => 27
end
end.
but I get error
Error: Non exhaustive pattern-matching: no clause found for pattern WW _
Why does it happen? Wrapper forces contained Wrapped to be A version, the type signature forces Y and WW constructor forbids being A and Y simultaneously. I don't understand why this case is being even considered, while I am forced to check it which seems to be impossible.
How to workaround this situation?
Let's simplify:
Inductive MyTy : Set -> Type :=
MkMyTy : forall (A : Set), A -> MyTy A.
Definition extract (m : MyTy nat) : nat :=
match m with MkMyTy _ x => S x end.
This fails:
The term "x" has type "S" while it is expected to have type "nat".
wat.
This is because I said
Inductive MyTy : Set -> Type
This made the first argument to MyTy an index of MyTy, as opposed to a parameter. An inductive type with a parameter may look like this:
Inductive list (A : Type) : Type :=
| nil : list A
| cons : A -> list A -> list A.
Parameters are named on the left of the :, and are not forall-d in the definition of each constructor. (They are still present in the constructors' types outside of the definition: cons : forall (A : Type), A -> list A -> list A.) If I make the Set a parameter of MyTy, then extract can be defined:
Inductive MyTy (A : Set) : Type :=
MkMyTy : A -> MyTy A.
Definition extract (m : MyTy nat) : nat :=
match m with MkMyTy _ x => S x end.
The reason for this is that, on the inside, a match ignores anything you know about the indices of the scrutinee from the outside. (Or, rather, the underlying match expression in Gallina ignores the indices. When you write a match in the source code, Coq tries to convert it into the primitive form while incorporating information from the indices, but it often fails.) The fact that m : MyTy nat in the first version of extract simply did not matter. Instead, the match gave me S : Set (the name was automatically chosen by Coq) and x : S, as per the constructor MkMyTy, with no mention of nat. Meanwhile, because MyTy has a parameter in the second version, I actually get x : nat. The _ is really a placeholder this time; it is mandatory to write it as _, because there's nothing to match, and you can Set Asymmetric Patterns to make it disappear.
The reason we distinguish between parameters and indices is because parameters have a lot of restrictions—most notably, if I is an inductive type with parameters, then the parameters must appear as variables in the return type of each constructor:
Inductive F (A : Set) : Set := MkF : list A -> F (list A).
(* ^--------^ BAD: must appear as F A *)
In your problem, we should make parameters where we can. E.g. the match wr with Wrap Y w => _ end bit is wrong, because the XY argument to Wrapper is an index, so the fact that wr : Wrapper Y is ignored; you would need to handle the Wrap X w case too. Coq hasn't gotten around to telling you that.
Inductive Wrapped (ab : AB) : XY -> Set :=
| W : forall (xy : XY), Wrapped ab xy
| WW : Wrapped ab (match ab with A => X | B => Y end).
Inductive Wrapper (xy : XY) : Set := WrapW : Wrapped A xy -> Wrapper xy.
And now your test compiles (almost):
Definition test (wr : Wrapper Y): nat :=
match wr with
| WrapW _ w => (* mandatory _ *)
match w with
| W _ Y => 27 (* mandatory _ *)
end
end.
because having the parameters gives Coq enough information for its match-elaboration to use information from Wrapped's index. If you issue Print test., you can see that there's a bit of hoop-jumping to pass information about the index Y through the primitive matchs which would otherwise ignore it. See the reference manual for more information.
The solution turned out to be simple but tricky:
Definition test (wr : Wrapper Y): nat.
refine (match wr with
| WrapW Y w =>
match w in Wrapped ab xy return ab = A -> xy = Y -> nat with
| W A Y => fun _ _ => 27
| _ => fun _ _ => _
end eq_refl eq_refl
end);
[ | |destruct a]; congruence.
Defined.
The issue was that Coq didn't infer some necessary invariants to realize that WW case is ridiculous. I had to explicitly give it a proof for it.
In this solution I changed match to return a function that takes two proofs and brings them to the context of our actual result:
ab is apparently A
xy is apparently Y
I have covered real cases ignoring these assumptions, and I deferred "bad" cases to be proven false later which turned to be trivial. I was forced to pass the eq_refls manually, but it worked and does not look that bad.
Is there a way to use recursion with Coq's typeclasses? Like for e.g., in defining show for lists, if you want to call the show function for lists recursively, then you will have to use a fixpoint like so:
Require Import Strings.String.
Require Import Strings.Ascii.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Section showNormal.
Instance showList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ lshow xs
end
}.
End showNormal.
Which is all well and good, but what if I want to define some helper function that I'll use for defining Show instances? Like I want to create a more DAZZLING show function called magicShow that prints stars around something...
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ magicShow xs
end
}.
However, in this case Coq can't find a show instance for the list xs to pass to magicShow:
Error:
Unable to satisfy the following constraints:
In environment:
A : Type
H : Show A
lshow : list A -> string
l : list A
x : A
xs : list A
?H : "Show (list A)"
Is there any way to do this in general? I.e., can you define a method for a typeclass using functions that rely upon the typeclass instance that you're defining?
No, there's no way to do this. This works in Haskell because arbitrary recursive bindings are allowed, and the language doesn't care about the order of bindings. Coq is more restrictive on both fronts. This makes sense if you think about what the desugaring looks like: the recursive call to show would refer to the currently-being-defined instance by name, but that binding isn't in scope yet. And you can't make the instance itself a fixpoint because you're recursing on the structure of a type, not on a value of an algebraic data type.
Your inline fixpoint works for show, but the problem gets thornier if your method implementations refer to each other, such as
newtype MyInteger = MyInteger Integer
instance Num MyInteger where
MyInteger m + MyInteger n = MyInteger $ m + n
negate (MyInteger m) = MyInteger $ negate m
m - n = m + negate n
-- other methods
Here, the calls to (+) and negate in the definition of (-) needs to refer to the definitions of (+) and negate above, but this also doesn't work in Coq. The only solution is to define all your methods separately, manually referencing each other, and then define the instance simply by setting each method to the one you defined above. For example,
Inductive MyInteger := Mk_MyInteger : Integer -> MyInteger.
Definition add__MyInteger (m n : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
let 'Mk_MyInteger n' := n in
Mk_MyInteger (add m' n').
Definition negate__MyInteger (m : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
Mk_MyInteger (negate m').
Definition sub__MyInteger (m n : MyInteger) : MyInteger :=
add__MyInteger m (negate__MyInteger n).
Instance Num__MyInteger : Num MyInteger := {|
add := add__MyInteger;
negate := negate__MyInteger;
sub := sub__MyInteger;
(* other methods *)
|}.
If you must do this, it can be simulated by explicitly using the constructor of the underlying Record (since "Typeclasses are Records", to quote from Software Foundations [1]), which can be instantiated using the function(s) being defined as a fixpoint. I'll post three examples and explain where this can be useful.
The example you posted could be solved like this (all code tested for Coq 8.10.1):
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Print Show.
(* Record Show (A : Type) : Type := Build_Show { show : A -> string }
*)
Check Build_Show.
(* Build_Show : forall A : Type, (A -> string) -> Show A *)
Check #magicShow.
(* #magicShow : forall A : Type, Show A -> A -> string *)
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ #magicShow _ (#Build_Show _ lshow) xs
end
}.
If you are trying to define several typeclass methods like this, it's tricky to instantiate the record constructor, but it can be done by treating the functions as if they were defined by mutual recursion (although there doesn't necessarily have to be any actual mutual recursion). Here's a contrived example where Show now has two methods. Notice that the typeclass instance is added to the context with an anonymous let-in binding. Evidently, this is enough to satisfy Coq's typeclass resolution mechanism.
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show1 : A -> string
; show2 : A -> string
}.
Definition magicShow1 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show1 a ++ " **".
Definition magicShow2 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show2 a ++ " **".
Fixpoint show1__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow1 xs
end
with show2__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow2 xs
end.
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show1 := show1__list
; show2 := show2__list
}.
So why would you want to do this? A good example is when you are defining decidable equality on (rose) trees. In the middle of the definition, we have to recursively appeal to decidable equality of list (tree A). We would like to use the standard library helper function Coq.Classes.EquivDec.list_eqdec [2], which shows how to pass decidable equality on a type A to list A. Since list_eqdec requires a typeclass instance (the very one we are in the middle of defining), we have to use the same trick above:
Require Import Coq.Classes.EquivDec.
Require Import Coq.Program.Utils.
Set Implicit Arguments.
Generalizable Variables A.
Inductive tree (A : Type) : Type :=
| leaf : A -> tree A
| node : list (tree A) -> tree A.
Program Instance tree_eqdec `(eqa : EqDec A eq) : EqDec (tree A) eq :=
{ equiv_dec := fix tequiv t1 t2 :=
let _ := list_eqdec tequiv in
match t1, t2 with
| leaf a1, leaf a2 =>
if a1 == a2 then in_left else in_right
| node ts1, node ts2 =>
if ts1 == ts2 then in_left else in_right
| _, _ => in_right
end
}.
Solve Obligations with unfold not, equiv, complement in * ;
program_simpl ; intuition (discriminate || eauto).
Next Obligation.
destruct t1;
destruct t2;
( program_simpl || unfold complement, not, equiv in *; eauto ).
Qed.
Solve Obligations with split; (intros; try unfold complement, equiv ; program_simpl).
(*
No more obligations remaining
tree_eqdec is defined
*)
Commentary: There is no constructor for creating a record of type EqDec (since it only has one class method), so to convince Coq that list (tree A) has decidable equality, the invocation is simply list_eqdec tequiv. For the uninitiated, Program here is simply allowing for holes in the definition of the instance to be filled in later as Obligations, which is more convenient than writing the appropriate proofs inline.
I'm trying to implement a function that simply counts the number of occurrences of some nat in a bag (just a synonym for a list).
This is what I want to do, but it doesn't work:
Require Import Coq.Lists.List.
Import ListNotations.
Definition bag := list nat.
Fixpoint count (v:nat) (s:bag) : nat :=
match s with
| nil => O
| v :: t => S (count v t)
| _ :: t => count v t
end.
Coq says that the final clause is redundant, i.e., it just treats v as a name for the head instead of the specific v that is passed to the call of count. Is there any way to pattern match on values passed as function arguments? If not, how should I instead write the function?
I got this to work:
Fixpoint count (v:nat) (s:bag) : nat :=
match s with
| nil => O
| h :: t => if (beq_nat v h) then S (count v t) else count v t
end.
But I don't like it. I'd rather pattern match if possible.
Pattern matching is a different construction from equality, meant to discriminate data encoded in form of "inductives", as standard in functional programming.
In particular, pattern matching falls short in many cases, such as when you need potentially infinite patterns.
That being said, a more sensible type for count is the one available in the math-comp library:
count : forall T : Type, pred T -> seq T -> nat
Fixpoint count s := if s is x :: s' then a x + count s' else 0.
You can then build your function as count (pred1 x) where pred1 : forall T : eqType, T -> pred T , that is to say, the unary equality predicate for a fixed element of a type with decidable (computable) equality; pred1 x y <-> x = y.
I found in another exercise that it's OK to open up a match clause on the output of a function. In that case, it was "evenb" from "Basics". In this case, try "eqb".
Well, as v doesn't work in the match, I thought that maybe I could ask whether the head of the list was equal to v. And yes, it worked. This is the code:
Fixpoint count (v : nat) (s : bag) : nat :=
match s with
| nil => 0
| x :: t =>
match x =? v with
| true => S ( count v t )
| false => count v t
end
end.
EDIT
Require Import Bool List ZArith.
Variable A: Type.
Inductive error :=
| Todo.
Inductive result (A : Type) : Type :=
Ok : A -> result A | Ko : error -> result A.
Variable bool_of_result : result A -> bool.
Variable rules : Type.
Variable boolean : Type.
Variable positiveInteger : Type.
Variable OK: result unit.
Definition dps := rules.
Inductive dpProof :=
| DpProof_depGraphProc : list
(dps * boolean * option (list positiveInteger) * option dpProof) -> dpProof.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs => dpGraphProc R D cs
end
with dpGraphProc (R D: rules ) cs {struct cs} :=
match cs with
| nil => Ko unit Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end.
I got an error message saying that:
Recursive call to dpProof has principal argument equal to
"p2" instead of "cs'".
Recursive definition is:
"fun (R D : rules)
(cs : list
(dps * boolean * option (list positiveInteger) *
option dpProof)) =>
match cs with
| nil => Ko unit Todo
| (_, _, _, Some p2) :: _ => dpProof' R D p2
| (_, _, _, None) :: _ => OK
end".
If I do not use the mutual recursive and use the nested fixpoint, it will combine and pass the checker of termination. Here is the code that successfully combined.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs =>
match cs with
| nil => Ko _ Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end end.
I would like to understand deeper about the reason why it cannot pass the termination checker? Is it because they cannot guess the argument descreasing? Is there any way that I can use the mutually recursive to express my function dpGraphProc?
Also How can I write the function dpGraphProc that check in the whole list? Here I do not know how to use the argument cs'.
Mutual recursion is to be used either with a single inductive data-type or with different inductive data-types that have been defined together in a single inductive definition. In your case, you are using polymorphic data-types prod (the type of pairs), list, and option which were already defined before dpProof.
The nested fixpoint approach does not have the restriction.