How can I get the all parents of a element in Coq?
I define a set in Coq as follows:
Inductive Gen : Set :=
| BGen : nat -> nat -> Gen.
There are many instances such as:
Definition g1 = BGen 1 2.
Definition g2 = BGen 2 3.
Now, I want to get the parents element of 3, i.e. [1,2]. I write a function:
Fixpoint parents (c : nat) (l : list Gen) :=
match l with
| [] => []
| (BGen p c') :: l' => if beq_nat c c'
then [p]
else parents c l'
end.
I can only get the direct parent [2] of 3, How can I get the all parents such as [1,2] in this example?
You seem to be asking about how to compute the closure of a function under repeated function application. The key to the problem is to find a way to ensure termination, i.e., a way to determine the maximum number of times the function might be called. In this case, an easy upper bound is List.length l; an element cannot have more transitive-parents than there are generations. Using this insight, we can define a function that takes a list of numbers, and outputs a list of those numbers together with all of their parents, and then we apply this function List.length l times to itself, starting with parents of c:
Require Import Coq.Lists.List. Import ListNotations.
Require Import Coq.Sorting.Mergesort. Import NatSort.
Scheme Equality for nat.
Inductive Gen : Set :=
| BGen : nat -> nat -> Gen.
Definition g1 := BGen 1 2.
Definition g2 := BGen 2 3.
Fixpoint parents (l : list Gen) (c : nat) :=
match l with
| [] => []
| (BGen p c') :: l' => if nat_beq c c'
then [p]
else parents l' c
end.
Fixpoint deduplicate' (ls : list nat) :=
match ls with
| [] => []
| x :: [] => [x]
| x :: ((y :: ys) as xs)
=> if nat_beq x y
then deduplicate' xs
else x :: deduplicate' xs
end.
Definition deduplicate (ls : list nat) := deduplicate' (sort ls).
Definition parents_step (l : list Gen) (cs : list nat) :=
deduplicate (cs ++ List.flat_map (parents l) cs).
Fixpoint all_parents' (l : list Gen) (cs : list nat) (fuel : nat) :=
match fuel with
| 0 => cs
| S fuel'
=> all_parents' l (parents_step l cs) fuel'
end.
Definition all_parents (l : list Gen) (c : nat) :=
deduplicate (all_parents' l (parents l c) (List.length l)).
Definition gs := (g1::g2::nil).
Compute all_parents gs 3. (* [1; 2] *)
Related
I have trees of arbitrary arity, with the following type:
Inductive Tree : Set :=
| Node : list Tree -> Tree.
I can easily create a number of Fixpoint functions such as the following one:
Fixpoint nodecount (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (map nodecount trs))
end.
but none of the following 'filter' type, even in trivial cases such as this one :
Function nodecount' (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (map nodecount' ( filter ( fun x => true) trs)))
end.
Whatever the function behind the filter is, the compiler rejects the function as ill-formed.
Is there a way to provide Coq with a proof that this class of filter functions actually produces well-behaved terms, so that any member of this class of fixpoints is allowed ?
Thank you for your help !
One solution is to use mapfilter : (A -> option B) -> list A -> list B instead of filter and a separate map. You also need to be careful in defining mapfilter so that the function argument is not part of the fix arguments.
This works because after unfolding mapfilter in nodecount', the recursive call to nodecount' will be syntactically a subterm of the input tree.
Definition mapfilter {A B : Type} (f : A -> option B) : list A -> list B :=
fix mapfilter_f (xs : list A) : list B :=
match xs with
| nil => nil
| x :: xs => match f x with
| Some y => y :: mapfilter_f xs
| None => mapfilter_f xs
end
end.
Fixpoint nodecount' (p : Tree -> bool) (tree: Tree ) : nat :=
match tree with
| Node trs => S (sum (mapfilter (fun x => if p x then Some (nodecount' p x) else None) trs))
end.
Alternatively you can directly write the list recursion into the tree one:
Fixpoint nodecount (f : Tree -> bool) (t : Tree) : nat :=
if (f t) then
match t with
| Node l =>
(fix iter l1 :=
match l1 with
| nil => 1
| (a :: l2)%list => nodecount f a + iter l2
end) l
end
else 0.
I have the following code:
Here is the def of sorted:
Fixpoint sorted (l : list nat) :=
match l with
| [] => true
| x::xs => match xs with
| [] => true
| y :: ys => (x <=? y) && (sorted xs)
end
end.
Here is the def of insert:
Fixpoint insert (x : nat) (l : list nat) :=
match l with
| [] => [x]
| y::ys => if x <=? y then x :: l
else y :: insert x ys
end.
Here is the def of insert_spec:
Definition insert_spec (x : nat) (l : list nat) :=
sorted l ==> sorted (insert x l).
In insert_spec, what does "==>" mean?
It appears that you got the code from Software Foundations' QuickChick guide. Many (if not all) of the notations used in that guide can be found in the QuickChick Reference Manual. There, we find that "==>" is defined as a notation.
Module QcNotation.
Export QcDefaultNotation.
Notation "x ==> y" :=
(implication x y) (at level 55, right associativity)
: Checker_scope.
End QcNotation.
implication is a generic "is this implication true" parameter used by QuickChick.
Parameter implication :
∀ {prop : Type} `{Checkable prop} (b : bool) (p : prop), Checker.
Whenever the first argument is true, QuickChick tests that the second argument evaluates (in whatever context you're using QuickChick in) as true too.
So for your particular piece of code, "==>" is used to say that we want to test that whenever l is sorted, insert x l is sorted too.
I have an "enumerate" function written in the Coq term language (what is it called?). This function is kind of annoying to use because it requires that A (the type of an element in the list l) be explicitly provided whenever the enumerate function is used. Is there a way to avoid needing to explicitly pass A as a parameter?
(* [a, b] -> [(0,a), (1,b)] *)
Fixpoint enumerate (A : Type) (l : list A) : list (nat * A) :=
let empty : (list (nat * A)) := nil in
let incr_pair xy := match xy with
| (x, y) => ((S x), y)
end in
match l with
| nil => empty
| (x :: xs) => (O, x) :: (map incr_pair (enumerate A xs))
end.
I want to be able to write something like
Fixpoint enumerate (l : list A) : list (nat * A) := ...
Possibly with some additional syntax identifying what exactly A is.
Put arguments in brackets to make them implicit by default (see section 2.7.4 here). Also, you should probably write this function in a non-quadratic way with a nat accumulator.
Require Import Lists.List.
Import ListNotations.
Fixpoint enumerate_from {A : Type} (n : nat) (l : list A) : list (nat * A) :=
match l with
| [] => []
| x :: xs => (n, x) :: enumerate_from (S n) xs
end.
Definition enumerate {A} l : list (nat * A) := enumerate_from 0 l.
Compute (enumerate [3; 4; 5]). (* prints [(0, 3); (1, 4); (2, 5)] *)
Following the example given in the chapter GeneralRec of Chlipala book, I'm trying to write the mergesort algorithm.
Here is my code
Require Import Nat.
Fixpoint insert (x:nat) (l: list nat) : list nat :=
match l with
| nil => x::nil
| y::l' => if leb x y then
x::l
else
y::(insert x l')
end.
Fixpoint merge (l1 l2 : list nat) : list nat :=
match l1 with
| nil => l2
| x::l1' => insert x (merge l1' l2)
end.
Fixpoint split (l : list nat) : list nat * list nat :=
match l with
| nil => (nil,nil)
| x::nil => (x::nil,nil)
| x::y::l' =>
let (ll,lr) := split l' in
(x::ll,y::lr)
end.
Definition lengthOrder (l1 l2 : list nat) :=
length l1 < length l2.
Theorem lengthOrder_wf : well_founded lengthOrder.
Admitted.
The problem is that it is not possible to write the mergeSort function with the command Fixpoint since the function is not structurally decreasing :
Fixpoint mergeSort (l: list nat) : list nat :=
if leb (length l) 1 then l
else
let (ll,lr) := split l in
merge (mergeSort ll) (mergeSort lr).
Instead, one can use the command Program Fixpoint or Definition with the term Fix (as in Chlipala book).
However, if I'm writing this
Definition mergeSort : list nat -> list nat.
refine (Fix lengthOrder_wf (fun (l: list nat) => list nat)
(fun (l : list nat) => (fun mergeSort : (forall ls : list nat, lengthOrder ls l -> list nat )=>
if leb (length l) 1 then
let (ll,lr) := split l in
merge (mergeSort ll _) (mergeSort lr _)
else
l))).
I'm getting impossible goals :
2 subgoals, subgoal 1 (ID 65)
l : list nat
mergeSort : forall ls : list nat, lengthOrder ls l -> list nat
ll, lr : list nat
============================
lengthOrder ll l
subgoal 2 (ID 66) is:
lengthOrder lr l
That is why Chlipala suggests to change the definition of mergeSort this way:
Definition mergeSort : list nat -> list nat.
refine (Fix lengthOrder_wf (fun _ => list nat)
(fun (ls : list nat)
(mergeSort : forall ls' : list nat, lengthOrder ls' ls -> list nat) =>
if Compare_dec.le_lt_dec 2 (length ls)
then let lss := split ls in
merge (mergeSort (fst lss) _) (mergeSort (snd lss) _)
else ls)).
that generates the following goals:
2 subgoals, subgoal 1 (ID 68)
ls : list nat
mergeSort : forall ls' : list nat, lengthOrder ls' ls -> list nat
l : 2 <= length ls
lss := split ls : list nat * list nat
============================
lengthOrder (fst lss) ls
subgoal 2 (ID 69) is:
lengthOrder (snd lss) ls
This new definition sounds like magic to me. So I wonder:
Fom the first definition, is it still possible to proof the well-foudness of the function?
Otherwise why the first definition cannot work?
How a basic user can go from the first definition to the second easily?
It's easy to see that you need to make two changes in order to get to A. Chlipala's solution.
1) When doing split you somehow need to remember that ll and lr came from split, otherwise they would be some arbitrary lists, which cannot possibly be shorter than the original list l.
The following piece of code fails to save that kind of information:
let (ll,lr) := split l in
merge (mergeSort ll _) (mergeSort lr _)
and, thus, needs to be replaced with
let lss := split ls in
merge (mergeSort (fst lss) _) (mergeSort (snd lss) _)
which keeps what we need.
The failure happens due to Coq's inability to remember that ll and lr come from split l and that happens because let (ll,lr) is just match in disguise (see the manual, §2.2.3).
Recall that the aims of pattern-matching is to (loosely speaking)
unpack the components of some value of an inductive datatype and bind them to some names (we'll need this in the 2nd part of my answer) and
replace the original definition with its special cases in the corresponding pattern-match branches.
Now, observe that split l does not occur anywhere in the goal or context before we pattern-match on it. We just arbitrarily introduce it into the definition. That's why pattern-matching doesn't give us anything -- we can't replace split l with its "special case" ((ll,lr)) in the goal or context, because there is no split l anywhere.
There is an alternative way of doing this by using logical equality (=):
(let (ll, lr) as s return (s = split l -> list nat) := split l in
fun split_eq => merge (mergeSort ll _) (mergeSort lr _)) eq_refl
This is analogous to using the remember tactic. We've got rid of fst and snd, but it is a huge overkill and I wouldn't recommend it.
2) Another thing we need to prove is the fact that ll and lr are shorter than l when 2 <= length l.
Since an if-expression is a match in disguise as well (it works for any inductive datatype with exactly two constructors), we need some mechanism to remember that leb 2 (length l) = true in the then branch. Again, since we don't have leb anywhere, this information gets lost.
There are at least two possible solutions to the problem:
either we remember leb 2 (length l) as an equation (just as we did in the 1st part), or
we can use some comparison function with result type behaving like bool (so it can represent two alternatives), but it should also remember some additional information we need. Then we could pattern-match on the comparison result and extract the information, which, of course, in this case have to be a proof of 2 <= length l.
What we need is a type which is able to carry a proof of m <= n in the case when leb m n returns true and a proof of, say, m > n otherwise.
There is a type in the standard library that does exactly that! It's called sumbool:
Inductive sumbool (A B : Prop) : Set :=
left : A -> {A} + {B} | right : B -> {A} + {B}
{A} + {B} is just a notation (syntactic sugar) for sumbool A B.
Just as bool, it has two constructors, but in addition it remembers a proof of either of two propositions A and B. Its advantage over bool shows up when you do case analysis on it with if: you get a proof of A in the then branch and a proof of B in the else branch. In other words, you get to use context you saved beforehand, whereas bool doesn't carry any context (only in the mind of the programmer).
And we need exactly that! Well, not in the else branch, but we would like to get 2 <= length l in our then branch. So, let us ask Coq if it already has a comparison function with the return type like that:
Search (_ -> _ -> {_ <= _} + {_}).
(*
output:
le_lt_dec: forall n m : nat, {n <= m} + {m < n}
le_le_S_dec: forall n m : nat, {n <= m} + {S m <= n}
le_ge_dec: forall n m : nat, {n <= m} + {n >= m}
le_gt_dec: forall n m : nat, {n <= m} + {n > m}
le_dec: forall n m : nat, {n <= m} + {~ n <= m}
*)
Any of the five results would do, because we need a proof only in one case.
Hence, we can replace if leb 2 (length l) then ... with if le_lt_dec 2 (length l) ... and get 2 <= length in the proof context, which will let us finish the proof.
I'm working in Coq and trying to figure out how to do the next thing: If I have a list of natural numbers and a given number n, I want to break my list in what goes before and after each of the n's. To make it clearer, if I have the list [1; 2; 0; 3; 4; 0; 9] and the number n = 0, then I want to have as output the three lists: [1;2], [3;4] and [9]. The main problem I have is that I don't know how to output several elements on a Fixpoint. I think I need to nest Fixpoints but I just don't see how. As a very raw idea with one too many issues I have:
Fixpoint SubLists (A : list nat)(m : nat) :=
match A with
|[] => []
|n::A0 => if n =? m then (SubLists L) else n :: (SubLists L)
end.
I would very much appreciate your input on how to do this, and how to navigate having an output of several elements.
You can do this by combining a few fixpoints:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint prefix n l :=
match l with
| [] => []
| m :: l' => if beq_nat n m then []
else m :: prefix n l'
end.
Fixpoint suffix n l :=
match l with
| [] => l
| m :: l' => if beq_nat n m then l'
else suffix n l'
end.
Fixpoint split_at n l :=
match l with
| [] => []
| m :: l' => prefix n (m :: l') :: split_at n (suffix n (m :: l'))
end.
Notice that Coq's termination checker accepts the recursive call to split_at, even though it is not done syntactically a subterm of l. The reason for that is that it is able to detect that suffix only outputs subterms of its argument. But in order for this to work, we must return l, and not [] on its first branch (try changing it to see what happens!).
In addition to Arthur's solution, you can use an accumulator, which is typical of Functional Programming style:
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Definition add_acc m (s : list (list nat)) :=
match s with
| [] => [[m]]
| s :: ss => (m :: s) :: ss
end.
Fixpoint split_seq n l acc :=
match l with
| [] => map (#rev _) (rev acc)
| m :: l' => if beq_nat n m then
split_seq n l' ([] :: acc)
else
split_seq n l' (add_acc m acc)
end.
Compute (split_seq 0 [1; 2; 0; 3; 4; 0; 9] []).
Note that the result is reversed so you need to use rev. A bonus exercise is to improve this.
EDIT: Provided second variant that doesn't add [] for repeated separators.
Definition reset_acc (s : list (list nat)) :=
match s with
| [] :: ss => [] :: ss
| ss => [] :: ss
end.
Fixpoint split_seq_nodup n l acc :=
match l with
| [] => map (#rev _) (rev acc)
| m :: l' => if beq_nat n m then
split_seq_nodup n l' (reset_acc acc)
else
split_seq_nodup n l' (add_acc m acc)
end.
Compute (split_seq_nodup 0 [1; 2; 0; 3; 4; 0; 9] []).
An alternative way to tackle this issue is to formally describe the problem you are trying to solve and then either write a dependently-typed function proving that this problem can indeed be solved or using tactics to slowly build up your proof.
This is, if I am not mistaken, a relation describing the relationship between the outputs n and ns you want to pass your function and the output mss you want to get back.
The (* ------- *) lines are simple comments used to suggest that these constructors should be seen as inference rules: whatever is under one such line is the conclusion one can make based on the assumptions above it.
Inductive SubListsRel (n : nat) : forall (ns : list nat)
(mss : list (list nat)), Prop :=
| base : SubListsRel n nil (nil :: nil)
| consEq : forall ns m mss,
n = m -> SubListsRel n ns mss ->
(* ----------------------------- *)
SubListsRel n (m :: ns) (nil :: mss)
| consNotEq : forall ns m ms mss,
(n <> m) -> SubListsRel n ns (ms :: mss) ->
(* ------------------------------------------------- *)
SubListsRel n (m :: ns) ((m :: ms) :: mss)
.
We can then express your Sublists problem as being, given inputs n and ns, the existence of an output mss such that SubListsRel n ns mss holds:
Definition SubLists (n : nat) (ns : list nat) : Set :=
{ mss | SubListsRel n ns mss }.
Using tactics we can readily generate such Sublists for concrete examples in order to sanity-check our specification. We can for instance take the example you had in your original post:
Example example1 : SubLists 0 (1 :: 2 :: 0 :: 3 :: 4 :: 0 :: 9 :: nil).
Proof.
eexists ; repeat econstructor ; intro Hf; inversion Hf.
Defined.
And check that the output is indeed the list you were expecting:
Check (eq_refl : proj1_sig example1
= ((1 :: 2 :: nil) :: (3 :: 4 :: nil) :: (9 :: nil) :: nil)).
Now comes the main part of this post: the proof that forall n ns, SubLists n ns. Given that the premise of consNotEq assumes that mss is non-empty, we will actually prove a strengthened statement in order to make our life easier:
Definition Strenghtened_SubLists (n : nat) (ns : list nat) : Set :=
{ mss | SubListsRel n ns mss /\ mss <> nil }.
And given that oftentimes we will have goals of the shape something_absurd -> False, I define a simple tactic to handle these things. It introduces the absurd assumption and inverts it immediately to make the goal disappear:
Ltac dismiss := intro Hf; inversion Hf.
We can now prove the main statement by proving the strengthened version by induction and deducing it. I guess that here it's better for you to step through it in Coq rather than me trying to explain what happens. The key steps are the cut (proving a stronger statement), induction and the case analysis on eq_nat_dec.
Lemma subLists : forall n ns, SubLists n ns.
Proof
intros n ns; cut (Strenghtened_SubLists n ns).
- intros [mss [Hmss _]]; eexists; eassumption.
- induction ns.
+ eexists; split; [econstructor | dismiss].
+ destruct IHns as [mss [Hmss mssNotNil]];
destruct (eq_nat_dec n a).
* eexists; split; [eapply consEq ; eassumption| dismiss].
* destruct mss; [apply False_rect, mssNotNil; reflexivity |].
eexists; split; [eapply consNotEq; eassumption| dismiss].
Defined.
Once we have this function, we can come back to our example and generate the appropriate Sublists this time not by calling tactics but by running the function subLists we just defined.
Example example2 : SubLists 0 (1 :: 2 :: 0 :: 3 :: 4 :: 0 :: 9 :: nil) :=
subLists _ _.
And we can Check that the computed list is indeed the same as the one obtained in example1:
Check (eq_refl : proj1_sig example1 = proj1_sig example2).
Nota Bene: It is paramount here that our proofs are ended with Defined rather than Qed in order for them to be unfolded when computing with them (which is what we want to do here: they give us the list (list nat) we are looking for!).
A gist with all the code and the right imports.
Here is another take, based on the standard library function List.fold_left.
It works by maintaining an accumulator, which is a pair of the overall reversed result (a list of lists) and a current sublist (also reversed while accumulating). Once we reach a delimiter, we reverse the current sublist and put it into the resulting list of sublists. After executing fold_left, we reverse the result in the outermost match expression.
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.
Import ListNotations.
Definition split_skip_dup_delims (m : nat) (xs : list nat) :=
match fold_left
(fun (acctup: _ * _) x => let (acc, rev_subl) := acctup in
if beq_nat x m
then match rev_subl with (* a delimiter found *)
| [] => (acc, []) (* do not insert empty sublist *)
| _ => (rev rev_subl :: acc, []) end
else (acc, x :: rev_subl)) (* keep adding to the current sublist *)
xs
([],[]) with
| (acc, []) => rev acc (* list ends with a delimiter *)
| (acc, rev_subl) => rev (rev rev_subl :: acc) (* no delimiter at the end *)
end.
Eval compute in split_skip_dup_delims 0 [1; 2; 0; 0; 0; 3; 4; 0; 9].
(* = [[1; 2]; [3; 4]; [9]]
: list (list nat) *)