Well-founded recursion in Lean - theorem-proving

I am trying to to formalize Skew Heaps in Lean. I have defined the straightforward tree type:
inductive tree : Type
| leaf : tree
| node : tree -> nat -> tree -> tree
Next, I want to define the fusion operation the following way:
def fusion : arbre × arbre -> arbre
| (t1, leaf) := t1
| (leaf, t2) := t2
| (node g1 x1 d1, node g2 x2 d2) :=
if x1 <= x2
then (node (fusion (d1, node g2 x2 d2)) x1 g1)
else (node (fusion (d2, node g1 x1 d1)) x2 g2)
But, of course, Lean doesn't not accept this function, as it "failed to prove recursive application is decreasing, well founded relation". Apparently, it uses the lexicographical product of the sizes of the trees… and fails, obviously.
How can I tell it to use the sum of the sizes?

The following code works for me. There are docs on how well founded recursion works in lean at
https://github.com/leanprover-community/mathlib/blob/master/docs/extras/well_founded_recursion.md
def fusion : tree × tree -> tree
| (t1, leaf) := t1
| (leaf, t2) := t2
| (node g1 x1 d1, node g2 x2 d2) :=
if x1 <= x2
then (node (fusion (d1, node g2 x2 d2)) x1 g1)
else (node (fusion (d2, node g1 x1 d1)) x2 g2)
using_well_founded
{ rel_tac := λ _ _,
`[exact ⟨_, measure_wf (λ t, tree.sizeof t.1 + tree.sizeof t.2)⟩] }
The idea is that you have to give it a new relation, and a proof that the relation is well founded. This is the tuple ⟨_, measure_wf (λ t, tree.sizeof t.1 + tree.sizeof t.2)⟩ Any function to the natural numbers gives a well founded relation, the proof of this is measure_wf, and the _ is just a placeholder for the relation, since it can be inferred from the type of measure_wf (λ t, tree.sizeof t.1 + tree.sizeof t.2).

Related

The type checker's behavior while pattern matching in Coq

I'm trying to examine how the type checker works on the following function, but can't understand
how the type checker works in the second (the nested) match clause:
Definition plus_O_2 :=
(fix F (m : mynat) : m == plus m O :=
match m as m0 with
| O as m2 => myeq_refl O : m2 == plus m2 O
| S x as m2 => ((match F x in (m0 == m1) return (S m0 == S m1) with
| myeq_refl x0 => myeq_refl (S x0)
end) : m2 == plus m2 O)
end) : forall n : mynat, n == plus n O.
This is a function that provides proof that forall n : mynat, n == plus n O, where mynat, ==, plus are self-defined natural numbers, equality, and addition:
Inductive mynat :=
| O
| S (x:mynat).
Fixpoint plus (a b:mynat) :=
match a with
| O => b
| S n => S (plus n b)
end.
Inductive myeq {X:Type} : X -> X -> Prop :=
| myeq_refl : forall x, myeq x x.
Notation "x == y" := (myeq x y)
(at level 70, no associativity)
: type_scope.
(The definition for myeq and the corresponding Notation statement was referenced from Software Foundations Vol.1, https://softwarefoundations.cis.upenn.edu/lf-current/ProofObjects.html).
What I'm trying to understand is how Coq manages to type check this function. Here's what I understand of now:
F first receives m. It is expected to return a value of type m == plus m O (The proposition we want to show).
m passes through pattern matching.
If m is O (meant to represent zero), it returns myeq_refl O.
myeq_refl O has type O == O. Meanwhile, from F's definition, it is expected to have type O == plus O O. (My guess is that,) Coq compares these types while type checking, and notices that plus O O is equivalent to O by its definition, so it passes the type check.
If m is of form S x, a second pattern matching starts running.
F x will have the form x == plus x O. This structure is captured in the in clause, and the return clause specifies that the returning type will be S x == S (plus x O).
(I don't understand what happens here)
Since both patterns end up with the type m == plus m O, the function has the type forall n : mynat, n == plus n O.
Now, my questions are, what exactly happens with the type checker in where I wrote "I don't understand what happens here?" Particularly,
In my understanding, as the in clause specifies, F x is expected to have the type m0 == m1. Meanwhile, the matching clause myeq_refl x0 seems to have the type x0 == x0, where both sides are equal. Why does Coq's type checker match these two seemingly different types?
After the match (after =>), the match clause outputs myeq_refl (S x0), which should have type S x0 == S x0. Meanwhile, the return clause stipulates that the returning type should be S m0 == S m1, which in my understanding should be equivalent to S x == S (plus x O). These types, at first glance, seem different. How does Coq find out that these types are in fact equivalent?
Particularly, the second type seems to have a more complicated structure than the original proposition we want to show, n == plus n O, which should mean that Coq should not immediately be able to find that this is in fact equivalent to n == n.
The occurences of m0 and m1 inside the clause in m0 == m1 are actually binding occurences of the variables for the pattern matching construct (in particular for the return clause). Your code is actually the same as
Definition plus_O_2 :=
(fix F (m : mynat) : m == plus m O :=
match m as m0 with
| O as m2 => myeq_refl O : m2 == plus m2 O
| S x as m2 => ((match F x in (p == q) return (S p == S q) with
| myeq_refl x0 => myeq_refl (S x0)
end) : m2 == plus m2 O)
end) : forall n : mynat, n == plus n O.
where I renamed the name of the variables in the inner match.
Now the constructor myeq_refl x is by construction of type x == x which should also be p == q so in that branch, it is enough to build a term of type (S p == S q)[x/p, x/q] (where brackets denote substitution), that is of type S x == S x. Since myeq_refl is the only constructor of this inductive type, you are done with this match once you have provided such a witness.

Proving General Associativity in Groups

For a project I'm coding group theory through Coq, obviously associatvity of 3 elements is a given, however I'm struggling to prove it holds for a string of length n. That is, (x1 * ... * xn) is always the same regardless of how many brackets are in there, or there placement.
The relevant group code is
Structure group :=
{
e : G;
Op : G -> G -> G;
Inv : G -> G;
Associativity : forall (x y z : G), Op x (Op y z) = Op (Op x y) z;
LeftInverse : forall (x : G), Op (Inv x) x = e;
LeftIdentity : forall (x : G), Op e x = x;
}.
It's not the proof itself I have the issue with but how to code it. I can see at the very least I'll need a further function that allows me to operate on strings rather than just elements, but i've no idea how to get started. Any pointers?
Operating on strings directly is certainly possible, but cumbersome. When reasoning about languages, it is much more convenient to use abstract syntax trees instead. For your statement, we only want to consider combinations of elements with some binary operation, so a binary tree suffices:
Inductive tree T :=
| Leaf : T -> tree T
| Node : tree T -> tree T -> tree T.
For concreteness, I'll only consider the natural numbers under addition, but this generalizes to any other monoid (and thus any other group). We can write a function that sums all the elements of a tree:
Fixpoint sum_tree t : nat :=
match t with
| Leaf n => n
| Node t1 t2 => sum_tree t1 + sum_tree t2
end.
We can also write a function that flattens the tree, collecting all of its elements in a list
Fixpoint elements {T} (t : tree T) : list T :=
match t with
| Leaf x => [x]
| Node t1 t2 => elements t1 ++ elements t2
end.
With these ingredients, we can formulate the statement that you were looking for: if two trees (that is, two ways of putting parenthesis in an expression) have the same sequences of elements, then they must add up to the same number.
Lemma eq_sum_tree t1 t2 :
elements t1 = elements t2 -> sum_tree t1 = sum_tree t2.
I'll leave the proof of this statement to you. ;)

Computing with a finite subset of an infinite representation in Coq

I have a function Z -> Z -> whatever which I treat as a sort of a map from (Z, Z) to whatever, let's type it as FF.
With whatever being a simple sum constructible from nix or inj_whatever.
This map I initialize with some data, in the fashion of:
Definition i (x y : Z) (f : FF) : FF :=
fun x' y' =>
if andb (x =? x') (y =? y')
then inj_whatever
else f x y.
The =? represents boolean decidable equality on Z, from Coq's ZArith.
Now I would like to have equality on two of such FFs, I don't mind invoking functional_extensionality. What I would like to do now is to have Coq computationally decide equality of two FFs.
For example, suppose we do something along the lines of:
Definition empty : FF := fun x y => nix.
Now we add some arbitrary values to make foo and foo', those are equivalent under functional extensionality:
Definition foo := i 0 0 (i 0 (-42) (i 56 1 empty)).
Definition foo' := i 0 (-42) (i 56 1 (i 0 0 empty)).
What is a good way to automatically have Coq determine foo = foo'. Ltac level stuff? Actual terminating computation? Do I need domain restriction to a finite one?
The domain restriction is a bit of an intricate one. I manipulate the maps in a way f : FF -> FF, where f can extend the subset of Z x Z that the computation is defined on. As such, come to think of it, it can't be f : FF -> FF, but more like f : FF -> FF_1 where FF_1 is a subset of Z x Z that is extended by a small constant. As such, when one applies f n times, one ends up with FF_n which is equivalent to domain restriction of FF plus n * constant to the domain. So the function f slowly (by a constant factor) expands the domain FF is defined on.
As I said in the comment more specifics are needed in order to elaborate a satisfactory answer. See the below example --- intended for a step by step description --- on how to play with equality on restricted function ranges using mathcomp:
From mathcomp Require Import all_ssreflect all_algebra.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
(* We need this in order for the computation to work. *)
Section AllU.
Variable n : nat.
(* Bounded and unbounded fun *)
Definition FFb := {ffun 'I_n -> nat}.
Implicit Type (f : FFb).
Lemma FFP1 f1 f2 : reflect (f1 = f2) [forall x : 'I_n, f1 x == f2 x].
Proof. exact/(equivP eqfunP)/ffunP. Qed.
Lemma FFP2 f1 f2 :
[forall x : 'I_n, f1 x == f2 x] = all [fun x => f1 x == f2 x] (enum 'I_n).
Proof.
by apply/eqfunP/allP=> [eqf x he|eqf x]; apply/eqP/eqf; rewrite ?enumT.
Qed.
Definition f_inj (f : nat -> nat) : FFb := [ffun x => f (val x)].
Lemma FFP3 (f1 f2 : nat -> nat) :
all [fun x => f1 x == f2 x] (iota 0 n) -> f_inj f1 = f_inj f2.
Proof.
move/allP=> /= hb; apply/FFP1; rewrite FFP2; apply/allP=> x hx /=.
by rewrite !ffunE; apply/hb; rewrite mem_iota ?ltn_ord.
Qed.
(* Exercise, derive bounded eq from f_inj f1 = f_inj f2 *)
End AllU.
The final lemma should indeed allow you reduce equality of functions to a computational, fully runnable Gallina function.
A simpler version of the above, and likely more useful to you is:
Lemma FFP n (f1 f2 : nat -> nat) :
[forall x : 'I_n, f1 x == f2 x] = all [pred x | f1 x == f2 x] (iota 0 n).
Proof.
apply/eqfunP/allP=> eqf x; last by apply/eqP/eqf; rewrite mem_iota /=.
by rewrite mem_iota; case/andP=> ? hx; have /= -> := eqf (Ordinal hx).
Qed.
But it depends on how you (absent) condition on range restriction is specified.
After your edit, I think I should add a note on the more general topic of map equality, indeed you can define a more specific type of maps other than A -> B and then build a decision procedure.
Most typical map types [including the ones in the stdlib] will work, as long as they support the operation of "binding retrieval", so you can reduce equality to the check of finitely-many bound values.
In fact, the maps in Coq's standard library do already provide you such computational equality function.
Ok, this is a rather brutal solution which does not attempt to avoid doing the same case distinctions multiple times but it's fully automated.
We start with a tactic which inspects whether two integers are equal (using Z.eqb) and translates the results to a proposition which omega can deal with.
Ltac inspect_eq y x :=
let p := fresh "p" in
let q := fresh "q" in
let H := fresh "H" in
assert (p := proj1 (Z.eqb_eq x y));
assert (q := proj1 (Z.eqb_neq x y));
destruct (Z.eqb x y) eqn: H;
[apply (fun p => p eq_refl) in p; clear q|
apply (fun p => p eq_refl) in q; clear p].
We can then write a function which fires the first occurence of i it can find. This may introduce contradictory assumptions in the context e.g. if a previous match has revealed x = 0 but we now call inspect x 0, the second branch will have both x = 0 and x <> 0 in the context. It will be automatically dismissed by omega.
Ltac fire_i x y := match goal with
| [ |- context[i ?x' ?y' _ _] ] =>
unfold i at 1; inspect_eq x x'; inspect_eq y y'; (omega || simpl)
end.
We can then put everything together: call functional extensionality twice, repeat fire_i until there's nothing else to inspect and conclude by reflexivity (indeed all the branches with contradictions have been dismissed automatically!).
Ltac eqFF :=
let x := fresh "x" in
let y := fresh "y" in
intros;
apply functional_extensionality; intro x;
apply functional_extensionality; intro y;
repeat fire_i x y; reflexivity.
We can see that it discharges your lemma without any issue:
Lemma foo_eq : foo = foo'.
Proof.
unfold foo, foo'; eqFF.
Qed.
Here is a self-contained gist with all the imports and definitions.

How can I compare (equality) of two elements of same Set in Coq?

Inductive ty: Set :=
| I
| O.
Definition f (x: ty) (y: ty): nat :=
if x = y then 0 else 1.
I want the function f to compare two terms of type ty but it does not compile and I see this error:
The term x = y has type Prop which is not a (co-)inductive type.
You need to prove that equality is decidable for ty (which can be done automatically using decide equality) and then use that definition in the if ... then ... else ... statement. Concretely:
Inductive ty: Set :=
| I
| O.
Definition ty_eq_dec : forall (x y : ty), { x = y } + { x <> y }.
Proof.
decide equality.
Defined.
Definition f (x: ty) (y: ty): nat :=
if ty_eq_dec x y then 0 else 1.
You can use match to compare the elements of inductive data types.
Definition f x y := match x,y with I, I | O, O => 0 | _,_ => 1 end.
decide equality is a more general tactic and works for infinite sets, but it is good to know that it is match that is doing the real work.

Messing around with category theory

Motivation: I am attempting to study category theory while creating a Coq formalization of the ideas I find in whatever textbook I follow. In order to make this formalization as simple as possible, I figured I should identify objects with their identity arrow, so a category can be reduced to a set (class, type) of arrows X with a source mapping s:X->X, target mapping t:X->X, and composition mapping product : X -> X -> option X which is a partial mapping defined for t f = s g. Obviously the structure (X,s,t,product) should follow various properties. For the sake of clarity, I am spelling out the formalization I chose below, but there is no need to follow it I think in order to read my question:
Record Category {A:Type} : Type := category
{ source : A -> A
; target : A -> A
; product: A -> A -> option A
; proof_of_ss : forall f:A, source (source f) = source f
; proof_of_ts : forall f:A, target (source f) = source f
; proof_of_tt : forall f:A, target (target f) = target f
; proof_of_st : forall f:A, source (target f) = target f
; proof_of_dom: forall f g:A, target f = source g <-> product f g <> None
; proof_of_src: forall f g h:A, product f g = Some h -> source h = source f
; proof_of_tgt: forall f g h:A, product f g = Some h -> target h = target g
; proof_of_idl: forall a f:A,
a = source a ->
a = target a ->
a = source f ->
product a f = Some f
; proof_of_idr: forall a f:A,
a = source a ->
a = target a ->
a = target f ->
product f a = Some f
; proof_of_asc:
forall f g h fg gh:A,
product f g = Some fg ->
product g h = Some gh ->
product fg h = product f gh
}
.
I have no idea how practical this is and how far it will take me. I see this as an opportunity to learn category theory and Coq at the same time.
Problem: My first objective was to create a 'Category' which would resemble as much as possible the category Set. In a set theoretic framework, I would probably consider the class of triplets (a,b,f) where f is a map with domain a and range a subset of b. With this in mind I tried:
Record Arrow : Type := arrow
{ dom : Type
; cod : Type
; arr : dom -> cod
}
.
So that Arrow becomes my base type on which I could attempt building a structure of category. I start embedding Type into Arrow:
Definition id (a : Type) : Arrow := arrow a a (fun x => x).
which allows me to define the source and target mappings:
Definition domain (f:Arrow) : Arrow := id (dom f).
Definition codomain (f:Arrow) : Arrow := id (cod f).
Then I move on to defining a composition on Arrow:
Definition compose (f g: Arrow) : option Arrow :=
match f with
| arrow a b f' =>
match g with
| arrow b' c g' =>
match b with
| b' => Some (arrow a c (fun x => (g' (f' x))))
| _ => None
end
end
end.
However, this code is illegal as I get the error:
The term "f' x" has type "b" while it is expected to have type "b'".
Question: I have the feeling I am not going to get away with this, My using Type naively would take me to some sort of Russel paradox which Coq will not allow me to do. However, just in case, is there a way to define compose on Arrow?
Your encoding does not work in plain Coq because of the constructive nature of the theory: it is not possible to compare two sets for equality. If you absolutely want to follow this approach, Daniel's comment sketches a solution: you need to assume a strong classical principle to be able to check whether the endpoints of two arrows match, and then manipulate an equality proof to make Coq accept the definition.
Another approach is to have separate types for arrows and objects, and use type dependency to express the compatibility requirement on arrow endpoints. This definition requires only three axioms, and considerably simplifies the construction of categories:
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Record category : Type := Category {
obj : Type;
hom : obj -> obj -> Type;
id : forall {X}, hom X X;
comp : forall X Y Z, hom X Y -> hom Y Z -> hom X Z;
(* Axioms *)
idL : forall X Y (f : hom X Y), comp id f = f;
idR : forall X Y (f : hom X Y), comp f id = f;
assoc : forall X Y Z W
(f : hom X Y) (g : hom Y Z) (h : hom Z W),
comp f (comp g h) = comp (comp f g) h
}.
We can now define the category of sets and ask Coq to automatically prove the axioms for us.
Require Import Coq.Program.Tactics.
Program Definition Sets : category := {|
obj := Type;
hom X Y := X -> Y;
id X := fun x => x;
comp X Y Z f g := fun x => g (f x)
|}.
(This does not lead to any circularity paradoxes, because of Coq's universe mechanism: Coq understands that the Type used in this definition is actually smaller than the one used to define category.)
This encoding is sometimes inconvenient due to the lack of extensionality in Coq's theory, because it prevents certain axioms from holding. Consider the category of groups, for example, where the morphisms are functions that commute with the group operations. A reasonable definition for these morphisms could be as follows (assuming that there is some type group representing groups, with * denotes multiplication and 1 denotes the neutral element).
Record group_morphism (X Y : group) : Type := {
mor : X -> Y;
mor_1 : mor 1 = 1;
mor_m : forall x1 x2, mor (x1 * x2) = mor x1 * mor x2
}.
The problem is that the properties mor_1 and mor_m interfere with the notion of equality for elements of group_morphism, making the proofs for associativity and identity that worked for Sets break. There are two solutions:
Adopt extra axioms into the theory so that the required properties still go through. In the above example, you would need proof irrelevance:
proof_irrelevance : forall (P : Prop) (p q : P), p = q.
Change the category axioms so that the identities are valid up to some equivalence relation specific to that category, instead of the plain Coq equality. This approach is followed here, for example.