Lean4: Proving that `(xs = ys) = (reverse xs = reverse ys)` - logic

Intuitively stating that xs is equal to ys is the same as saying that the respective reverse lists are equal to each other.
I'm currently learning Lean 4 and so I set myself the following exercise. I want to prove the following theorem in Lean 4:
theorem rev_eq (xs ys : List α) : (xs = ys) = (reverse xs = reverse ys)
However, I am not sure, whether this theorem can actually be proven in Lean 4. If not, why can it not be proven?
The closest I could get so far is proving the claim under the assumption that xs = ys:
theorem rev_eq' (xs ys : List α) :
xs = ys -> (xs = ys) = (reverse xs = reverse ys) := by
intros h
rw [h]
simp
Maybe, if one could prove that the claim also holds if one assumes that xs is not equal to ys, then the original theorem would follow. I got stuck on that route as well though.
Any ideas?

In Lean, it is usually idiomatic to state the equality of propositions using Iff, which is equivalent under the axiom propext. From there, iff is an inductive type with two sides, one direction that you have proved, and the other direction that follows from induction. (This theorem is still provable without this axiom, fwiw)
But I'd recommend you to do induction xs and induction ys and then look at the goals. Two should be impossible and Lean should show you they are contradictions (or indeed you'll get a that can be simplified to false = false) and two trivially true goals. Make sure to expand the definition of reverse.

This property is typically proved by induction. I never used lean but once induction on the list is done then it should be easy. You may need a lemma saying that (xs = ys) -> xs#l = xs#l (also by induction I guess, # stands for list concatenation).

Related

I'm trying to build a proof in Coq that two different permutation definitions are equivalent, but the non-inductive side is not working

The two definitions are these:
Inductive perm : list nat -> list nat -> Prop :=
| perm_eq: forall l1, perm l1 l1
| perm_swap: forall x y l1, perm (x :: y :: l1) (y :: x :: l1)
| perm_hd: forall x l1 l2, perm l1 l2 -> perm (x :: l1) (x :: l2)
| perm_trans: forall l1 l2 l3, perm l1 l2 -> perm l2 l3 -> perm l1 l3.
Fixpoint num_oc (x: nat) (l: list nat): nat :=
match l with
| nil => 0
| h::tl =>
if (x =? h) then S (num_oc x tl) else num_oc x tl
end.
Definition equiv l l' := forall n:nat, num_oc n l = num_oc n l'.
The theorem that I'm trying to prove is this:
Theorem perm_equiv: forall l l', equiv l l' <-> perm l l'.
The perm -> equiv direction is ready, but the equiv -> perm direction isn't working. I tried this strategy:
- intro H. unfold equiv in H.
generalize dependent l'.
induction l.
+ intros l' H. admit.
+ intros l' H. simpl in H.
generalize dependent l'.
intro l'. induction l'.
* intro H. specialize (H a).
rewrite <- beq_nat_refl in H.
simpl in H. Search False.
inversion H.
destruct (a =? a0) eqn:Ha.
** simpl in H. inversion H.
** apply False_ind.
apply beq_nat_false in Ha.
apply Ha. reflexivity.
* destruct (x =? a). *).
I'm out of ideas for the first branch, so it's admitted for now, but the second one is crashing at the destruct tactic. How do I proceed with this proof?
You should attempt to write a proof on paper before attempting to encode it in Coq. Here is a possible strategy.
Nil case
When l = [], you know that every number in l' occurs zero times because of H. It should be possible to prove an auxiliary lemma that implies that l' = [] in this case. You can conclude with perm_eq.
Cons case
Suppose that l = x :: xs. Let n = num_oc x xs. We know that num_oc x l' = S n by H. You should be able to prove a lemma saying that l' is of the form ys1 ++ x :: ys2 where num_oc x ys1 = 0. This would allow you to show that equiv xs (ys1 ++ ys2). By the induction hypothesis, you find that perm xs (ys1 ++ ys2). Hence, by perm_hd, perm (x :: xs) (x :: ys1 ++ ys2).
You should be able to prove that perm is a transitive relation and that perm (x :: ys1 ++ ys2) (ys1 ++ x :: ys2) holds. Combined with the last assertion, this will yield perm l l'.
The main takeaway in this case is that attempting to write every proof with single, direct induction is only going to work for the simplest results. You should start thinking about how to break down your results into simpler intermediate lemmas that you can combine to prove your final result.

Coq proof that complement is involutive

How can I prove that the complement of a set is involutive?
Require Import Ensembles. Arguments In {_}. Arguments Complement {_}.
Variables (T:Type) (A:Ensemble T).
Axiom set_eq: forall (E1 E2:Ensemble T), (forall x, E1 x <-> E2 x) -> E1 = E2.
Lemma complement_involutive:
forall x, In (Complement (Complement A)) x -> In A x.
EDIT: Assuming decidable (In A x) enables firstorder to prove the lemma completely.
complement_involutive is exactly ~ ~ A x -> A x which is well-known to be equivalent to excluded middle, in this case in Type, thus not provable in Coq without assuming it as an axiom. See this answer https://math.stackexchange.com/questions/1370805/why-cant-you-prove-the-law-of-the-excluded-middle-in-intuitionistic-logic-for

Provably correct permutation in less than O(n^2)

Written in Haskell, here is the data type that proves that one list is a permutation of another:
data Belongs (x :: k) (ys :: [k]) (zs :: [k]) where
BelongsHere :: Belongs x xs (x ': xs)
BelongsThere :: Belongs x xs xys -> Belongs x (y ': xs) (y ': xys)
data Permutation (xs :: [k]) (ys :: [k]) where
PermutationEmpty :: Permutation '[] '[]
PermutationCons :: Belongs x ys xys -> Permutation xs ys -> Permutation (x ': xs) xys
With a Permutation, we can now permute a record:
data Rec :: (u -> *) -> [u] -> * where
RNil :: Rec f '[]
(:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)
insertRecord :: Belongs x ys zs -> f x -> Rec f ys -> Rec f zs
insertRecord BelongsHere v rs = v :& rs
insertRecord (BelongsThere b) v (r :& rs) = r :& insertRecord b v rs
permute :: Permutation xs ys -> Rec f xs -> Rec f ys
permute PermutationEmpty RNil = RNil
permute (PermutationCons b pnext) (r :& rs) = insertRecord b r (permute pnext rs)
This works fine. However, permute is O(n^2) where n is the length of the record. I'm wondering if there is a way to get it to be any faster by using a different data type to represent a permutation.
For comparison, in a mutable and untyped setting (which I know is a very different setting indeed), we could apply a permutation to a heterogeneous record like this in O(n) time. You represent the record as an array of values and the permutation as an array of new positions (no duplicates are allowed and all digits must be between 0 and n). Applying the permutation is just iterating that array and indexing into the record's array with those positions.
I don't expect that an O(n) permutation is possible in a more rigorously typed settings. But it seems like O(n*log(n)) might be possible. I appreciate any feedback, and let me know if I need to clarify anything. Also, answers to this can use Haskell, Agda, or Idris depending on what it feels easier to communicate with.
A faster simple solution is to compare the sorted permutation of the permutations.
Given permutation A and B.
Then there exist the sorted permutations,
As = sort(A)
Bs = sort(B)
As is a permutation of A and Bs is a permutation of B.
If As == Bs then A is a permutation of B.
Thus the order of this algorithm is O(n log(n)) < O(n²)
And this is leading to the optimal solution.
Using a different storage of permutation yields O(n)
Using the statements from above, we are changing the storage format of each permutation into
the sorted data
the original unsorted data
To determine if a list is a permutation of another one, simple a comparison of the sorted data is necessary -> O(n).
This answers the question correctly, but the effort is hidden in creating the doubled data storage ^^ So it will depend on the use if this is a real advantage or not.

The smallest free number - divide and conquer algorithm

I'm reading a book Pearls of Functional Algorithm Design. Tried implementing the divide and conquer solution for smallest free number problem.
minfree xs = minfrom 0 (length xs) xs
minfrom a 0 _ = a
minfrom a n xs = if m == b - a
then minfrom b (n-m) vs
else minfrom a (m) us
where b = a + 1 + (n `div` 2)
(us,vs) = partition (<b) xs
m = length us
But this one works no faster than the solution that one might call "naive" solution. Which is
import Data.List ((\\))
minfree' = head . (\\) [0..]
I don't know why this is like this, what's wrong with the divide and conquer algorithm and how to improve it.
Tried using BangPatterns, implementing the version of partition that also returns first list's length in the tuple, so it eliminates additional traversal for m =length us. None of them made improvement.
First one takes more than 5 seconds, whereas second one does it almost instantly in ghci on input [0..9999999].
You have pathological input on which head . (\\) [0..] performs in O(N) time. \\ is defined as follows:
(\\) = foldl (flip delete)
delete x xs is an O(N) operation that removes the first x from xs. foldl (flip delete) xs ys deletes all elements of ys from xs one by one.
In [0..] \\ [0..9999999], we always find the next element to be deleted at the head of the list, so the result can be evaluated in linear time.
If you instead type minfree' (reverse [0..9999999]) into GHCi, that takes quadratic time and you find that it pretty much never finishes.
The divide-and-conquer algorithm on the other hand would not slow down on the reversed input.

Proving insertion sort algorithm using Isabelle

I did some implementation of the insert sort algorithm in Isabelle/HOL for the generation of code (ML, Python, among others). I'm sure the corresponding functions work fine, but I need to create some theorems to prove it and be super sure it works. My functions are these:
(* The following functions are used to prove the algorithm works fine *)
fun menor_igual :: "nat ⇒ nat list ⇒ bool" where
"menor_igual n [] = True" |
"menor_igual n (x # xs) = (n ≤ x ∧ menor_igual n xs)"
fun ordenado :: "nat list ⇒ bool" where
"ordenado [] = True" |
"ordenado (x # xs) = (menor_igual x xs ∧ ordenado xs)"
fun cuantos :: "nat list ⇒ nat ⇒ nat" where
"cuantos [] num = 0" |
"cuantos (x # xs) num = (if x = num then Suc (cuantos xs num) else cuantos xs num)"
(* These functions make the algorithm itself *)
fun insertar:: "nat ⇒ nat list ⇒ nat list" where
"insertar num [] = [num]" |
"insertar num (x # xs) = (if (num ≤ x) then (num # x # xs) else x # insertar num xs)"
fun asc :: "nat list ⇒ nat list" where
"asc [] = []" |
"asc (x # xs) = insertar x (asc xs)"
The issues is I don't know how to create the theorems correctly. I need to prove that the ordered list has the same length as the original list, and that both lists have the same name of elements. My first theorems are these:
theorem "ordenado (asc xs)"
apply (induction xs rule: asc.induct)
apply auto
theorem "cuantos (asc xs) x = cuantos xs x"
apply (induction xs rule: asc.induct)
apply auto
The first theorem tries to prove that the list is correctly ordered, the second one tries to prove that both lists have the same length.
When I apply induction and auto I expect to get 0 subgoals, that says the theorems are right and the algorithm works fine, but after that I don't know how to remove the subgolas, I mean I don't know how to do the simplification rules (lemma [simp]: "") to do it, I'll appreciate your help.
After
theorem "ordenado (asc xs)"
apply (induction xs rule: asc.induct)
apply auto
you still have to prove the following subgoal:
1. ⋀x xs.
ordenado (asc xs) ⟹
ordenado (insertar x (asc xs))
That is, assuming that asc xs is sorted, you have to prove that insertar x (asc xs) is sorted. This suggests to first prove an auxiliary lemma about the interaction between insertar and ordenado
lemma ordenado_insertar [simp]:
"ordenado (insertar x xs) = ordenado xs"
...
which states that insertar x xs is sorted if and only if xs was already sorted. In order to prove this lemma you will again need auxiliary lemmas. This time about menor_igual and the interaction between menor_igual and insertar.
lemma le_menor_igual [simp]:
"y ≤ x ⟹ menor_igual x xs ⟹ menor_igual y xs"
...
lemma menor_igual_insertar [simp]:
"menor_igual y (insertar x xs) ⟷ y ≤ x ∧ menor_igual y xs"
...
The first one states that if y is smaller-equal x and x is smaller-equal all elements of xs, then y is smaller-equal all elements of xs, etc. ...
I leave the proofs as an exercise ;).
For your second theorem I suggest to follow the same recipe. First try induct followed by auto (as you already did), then find out what properties are still missing, prove them as auxiliary lemmas and finish your proofs.

Resources