Agda: std-lib: List: all but last element with snoc - list

I defined allButLast this way:
allButLast : ∀ {a} {A : Set a} → List A → List A
allButLast l.[] = l.[]
allButLast list = l.reverse (tail' (l.reverse list))
and would like to prove the following statement:
allButLast-∷ʳ :
∀ {a} {A : Set a} →
(list : List A) →
(y : A) →
allButLast (list ∷ʳ y) ≡ list
allButLast-∷ʳ [] y = refl
allButLast-∷ʳ (x ∷ []) y = refl
allButLast-∷ʳ (x ∷ xs) y =
begin
allButLast ((x ∷ xs) ++ [ y ])
≡⟨⟩
reverse (tail' (reverse ((x ∷ xs) ∷ʳ y)))
≡⟨ ? ⟩
reverse (tail' (y ∷ reverse (x ∷ xs)))
≡⟨⟩
reverse (reverse (x ∷ xs))
≡⟨ reverse-involutive (x ∷ xs) ⟩
(x ∷ xs)
∎
where I need to find what to replace ? with.
I defined:
reverse-∷ʳ :
∀ {a} {A : Set a} →
(list : List A) →
(n : A) →
reverse (list ∷ʳ n) ≡ n ∷ reverse list
which I was able to prove.
I wanted to use it as reverse-∷ʳ (x ∷ xs) y to replace ? however, I get the following error:
x ∷ [] != [] of type List A
when checking that the expression reverse-∷ʳ (x ∷ xs) y has type
reverse (tail' (reverse ((x ∷ xs) ∷ʳ y))) ≡
reverse (tail' (y ∷ reverse (x ∷ xs)))
I'm not sure how to interpret it.
Is this because I'm not covering the case x ∷ [] when I apply reverse-∷ʳ (x ∷ xs) y?

I suggest the following solution:
allButLast : ∀ {a} {A : Set a} → List A → List A
allButLast [] = []
allButLast (_ ∷ []) = []
allButLast (x ∷ x₁ ∷ l) = x ∷ (allButLast (x₁ ∷ l))
allButLast-∷ʳ : ∀ {a} {A : Set a} {l : List A} {x} → allButLast (l ∷ʳ x) ≡ l
allButLast-∷ʳ {l = []} = refl
allButLast-∷ʳ {l = _ ∷ []} = refl
allButLast-∷ʳ {l = x ∷ x₁ ∷ l} = cong (x ∷_) (allButLast-∷ʳ {l = x₁ ∷ l})
For a while now, you've been asking quite a lot of questions in #Agda and this is completely fine. However, and don't take this the wrong way, you should definitely try and understand what you're doing instead of asking similar questions again and again. It seems to me that you do not quite understand how to write definitions nor proofs in Agda, simply because you don't take enough time to try and understand how all of this work. For instance, your precedent question shows that you don't quite understand yet the difference between functions and constructors, as well as pattern matching. In addition, you always try and use chained equalities to prove your goals even though in most cases a simple case split on the data you are working on (mostly lists and vects) is sufficient to solve your issue. You tend to overcomplicate matters, and believe me, this is not what you want to do when developing in Agda or other proof assistants, because proofs tend to quickly become very complicated by themselves. I can see that you're eager to learn and to improve your Agda skills, so here are a few suggestions, which will be more useful, in the long run, than defining and proving random notions and properties in an incorrect manner :
take a step back from your definitions and proofs
take some time to figure out by head what the proof might be, if it's simple enough to be understood.
try to understand Agda's basic mechanisms, like case-splitting, instead of more advanced ones, like equality reasoning.
make sure you cannot prove your lemmas by a simple recursion over its input instead of more complex / time consuming ways.
follow some tutorials which you can find online, most of them are regrouped in the following wiki page https://agda.readthedocs.io/en/v2.6.0.1/getting-started/tutorial-list.html
try and understand (and possibly reproduce by yourself) the proofs that were given as answers to the questions you've asked here, because a lot of your new questions can actually be answered / solved in a similar manner.
when defining quantities, try and define them as simply as possible, for instance look at my allButLast definition as opposed to yours which uses other complex function instead of just being defined recursively over its input.
make sure your definition actually do what you intend, either by writing some simple test cases, and evaluating them using CTRL-C CTRL-N or by proving some very simple properties over them, with examples for instance. Your previous definition of allButLast, which can be found in your previous question, was actually the identity function over lists, because you always give back exactly the input, which can easily be seen with some tests and a little step back.
All in all, take your time and try to actually understand what you're doing, because there is no way you'll be able to develop anything significant in Agda if you don't. I hope these suggestions will help you, and that you will not take them the wrong way. There are probably many more, but that's a brief overview of those I could think of directly.

Related

How to fix the error ('cannot construct the infinite type') in my code and how to make my code work

Basically i'm trying to do a function where you are given a list and a number and you have to split the list in lists of the same size as the number given and the last split of all can have a length lower than the number given
separa a xs = if length xs >= a then separaM a (drop a xs) ([take a xs]) else [xs]
separaM a xs yss = if length xs >= a then separaM a (drop a xs) (yss : (take a xs)) else separaM a [] (yss : xs)
separaM a [] yss = yss
I expect the output of 3 "comovais" to be ["com","ova","is"] but in my program there is no output because of the error
Note that the expression:
yss : (take a xs)
(take a xs) has type [b], so yss has type b. But when you pass yss : (take a xs) as an argument to separaM function, yss is expected has type [b] not b. That is why the error occurred.
Actually, you don't need yss to store the result, the recursive function can be defined as:
separaM _ [] = []
separaM a xs = (if length xs >= a then (take a xs) else xs) :
separaM a (drop a xs)
Your code has some errors in it. Tweaking your misuse of (:) gets it to pass the type-checker:
separa a xs
| length xs >= a = go a (drop a xs) [take a xs]
| otherwise = [xs]
where
go a xs yss
| length xs >= a = go a (drop a xs) (yss ++ [take a xs])
-- was: (yss : (take a xs))
| otherwise = go a [] (yss ++ [xs])
-- was: (yss : xs)
go a [] yss = yss
but it's better to further change it to
separa :: Int -> [a] -> [[a]]
separa a xs
| length xs >= a = go a (drop a xs) [take a xs]
| otherwise = [xs]
where
go a xs yss
| length xs >= a = go a (drop a xs) ([take a xs] ++ yss)
| otherwise = reverse ([xs] ++ yss)
It works:
> separa 3 [1..10]
[[1,2,3],[4,5,6],[7,8,9],[10]]
This is a common "build in reverse, then reverse when built" idiom, frequently seen in strict functional languages. Some of them allow for lists to be built in top-down, natural order, by a technique known as tail-recursion modulo cons. Haskell is lazy, and lets us build its lists in top-down manner naturally and easily, with the equivalent guarded recursion:
separa :: Int -> [a] -> [[a]]
separa a xs
| length xs >= a = go a (drop a xs) [take a xs]
| otherwise = [xs]
where
go a xs yss
| length xs >= a = -- go a (drop a xs) (yss ++ [take a xs])
yss ++ go a (drop a xs) [take a xs]
| otherwise = -- go a [] (yss ++ [xs])
yss ++ [xs]
There's an off-by-one error here; I'll leave it for you to fix on your own.
But sometimes the infinite type is inherent to a problem, and not a result of a programming error. Then we can fix it by using recursive types.
Whenever we get type equivalency t ~ a..b..t..c.., we can start by defining a type
newtype T = MkT (a..b..T..c..)
then see which type variables are free and close over them, as
newtype T a b c = MkT (a..b..(T a b c)..c..)
An example: Infinite type error when defining zip with foldr only; can it be fixed?

Getting combination pairs of list elements

I am trying to get all combinations of a list. The result for [1,2,3] should be [(1,2),(1,3),(2,3)]. My implementation below, however, gives [(1,2),(2,3)].
parings [d] = []
parings (y:ys) = (y, head ys): parings ys
The list comprehension mentioned in 9000's answer can be trivially factored into a map call.
pairwise :: [a] -> [(a, a)]
pairwise [] = []
pairwise (x:xs) = map (\y -> (x, y)) xs ++ pairwise xs
Every list comprehension can be factored into some combination of map, filter, and concatMap, possibly with some let bindings interspersed. Doing so is a good exercise for learning how to manipulate functions.
Here is one implementation using tails from Data.List:
import Data.List
pairings :: [a] -> [(a, a)]
pairings = concatMap makePairs . tails
where
makePairs [] = []
makePairs (x:xs) = fmap ((,) x) xs
Notes:
I don't know whether tails counts as a "special import" for you -- though it is not in the Prelude, it can be found in the base library, which is always available.
To see what tails does, try tails [1..3].
((,) x) is just a compact way of writing (\y -> (x, y)). If you find it ugly, you can write the longer version instead, or enable the TupleSections extension and spell it as (x,).
makePairs might be written without explicit recursion as...
makePairs = maybe [] (\(x, xs) -> fmap ((,) x) xs) . uncons
... with uncons also being found in Data.List.
All the implementations in the answers here have a not insignificant problem: they retain consumed list segments in memory. To see what I'm talking about, watch the memory usage as you run head . drop 8000000 $ pairings [1..] in GHCi. I'm not confident about there being a workaround for that -- a simple concat . tails, for instance, appears to run into the same issue, while fmap makePairs . tails doesn't (even head . drop (10^9) . head . drop (10^9) . fmap makePairs . tails $ [1..] won't eat up all your memory).
I don't know why you're opposed to list comprehensions; with them, the solution is trivial:
pairwise :: [a] -> [(a, a)]
pairwise [] = []
pairwise (x:xs) = [(x, y) | y <- xs] ++ pairwise xs
You can factor out the comprehension into a separate function with explicit tail recursion if you want.
(The whole thing can be made tail-recursive, too, by keeping parameters for both sides of the ++ and having an accumulator parameter.)

How do I create an applicative instance for ziplist?

I want to implement an instance of Applicative for my custom list.
import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes
data List a =
Nil
| Cons a (List a)
deriving (Eq, Show)
instance Eq a => EqProp (List a) where (=-=) = eq
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons a Nil) = (Cons (f a) Nil)
fmap f (Cons a as) = (Cons (f a) (fmap f as))
main = do
let trigger = undefined :: List (Int, String, Int)
quickBatch $ applicative trigger
instance Arbitrary a => Arbitrary (List a) where
arbitrary = sized go
where go 0 = pure Nil
go n = do
xs <- go (n - 1)
x <- arbitrary
return (Cons x xs)
instance Applicative List where
pure x = (Cons x Nil)
Nil <*> _ = Nil
_ <*> Nil = Nil
(Cons f fs) <*> (Cons a as) = (Cons (f a) (fs <*> as))
This gives the following bugs:
λ> main
applicative:
identity: *** Failed! Falsifiable (after 3 tests):
Cons 0 (Cons (-1) Nil)
composition: *** Failed! Falsifiable (after 3 tests):
Cons <function> (Cons <function> Nil)
Cons <function> (Cons <function> Nil)
Cons 1 (Cons (-2) Nil)
homomorphism: +++ OK, passed 500 tests.
interchange: +++ OK, passed 500 tests.
functor: *** Failed! Falsifiable (after 3 tests):
<function>
Cons (-2) (Cons (-1) Nil)
First is the id law is failing:
λ> Cons id Nil <*> Cons 0 (Cons (-1) Nil)
Cons 0 Nil
How do I fix this? pure takes an a not a List a so I do not see how to match on List and preserve the nested list structure.
The composition law also fails which is not strange:
λ> (Cons "b" Nil) <*> (Cons "c" Nil)
<interactive>:295:7:
Couldn't match expected type ‘[Char] -> b’
with actual type ‘[Char]’
Relevant bindings include
it :: List b (bound at <interactive>:295:1)
In the first argument of ‘Cons’, namely ‘"b"’
In the first argument of ‘(<*>)’, namely ‘(Cons "b" Nil)’
In the expression: (Cons "b" Nil) <*> (Cons "c" Nil)
Edit: since I got great answers implementing applicative for ziplists, I have changed the question to be about ziplists.
For your ZipList-like approach we expect the following left-identity to hold:
pure id <*> someList = someList
For this, pure cannot return a single-element list, since this will stop immediately:
(Cons id Nil) <*> Cons 1 (Cons 2 Nil)
= Cons (id 1) (Nil <*> Cons 2 Nil)
= Cons 1 Nil
Which isn't the expected result for the left-identity. If pure cannot return only a single element list, how many should it return? The answer is: infinite:
repeatList :: a -> List a
repeatList x = let c = Cons x c in c
Why did I call this the ZipList approach? Because it's the same behaviour as in Control.Applicative.ZipList, which can be motivated with zipWith:
zipWithList :: (a -> b -> c) -> List a -> List b -> List c
zipWithList f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWithList f xs ys)
zipWithList _ _ _ = Nil
Now your instance is
instance Applicative List where
pure = repeatList
(<*>) = zipWithList ($)
However, checkers cannot check this instance either due to your EqProb instance, since pure f <*> pure x == pure (f x) (homomorphism) results in a check on infinite lists. You can provide an alternative one, though. For example, you can take an arbitrary number of elements and compare them:
prop_sameList :: Eq a => (Int, Int) -> List a -> List a -> Property
prop_sameList bounds xs ys = forAll (choose bounds) $ \n ->
takeList n xs `eq` takeList n ys
takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons x xs)
| n <= 0 = Nil
| otherwise = Cons x (takeList (n - 1) xs)
Then, if you want to compare at least 1000 and at most 10000 elements, you can use:
instance Eq a => EqProb (List a) where
(=-=) = prop_sameList (1000, 10000)
After all, we're just trying to find a list where our property does not hold.
Expanding on my comment to Zeta's much more deserving answer, you need a second change to get this test to run:
-- | Test lists for equality (fallibly) by comparing finite prefixes
-- of them. I've arbitrarily chosen a depth of 1,000. There may be
-- better ideas than that.
instance Eq a => EqProp (List a) where
xs =-= ys = takeList 1000 xs `eq` takeList 1000 ys
-- | Take a prefix of up to #n# elements from a 'List'.
takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons a as)
| n > 0 = Cons a (takeList (n-1) as)
| otherwise = Nil
With Zeta's changes and this one, your test suite passes:
applicative:
identity: +++ OK, passed 500 tests.
composition: +++ OK, passed 500 tests.
homomorphism: +++ OK, passed 500 tests.
interchange: +++ OK, passed 500 tests.
functor: +++ OK, passed 500 tests.
The key insight to get here is that QuickCheck is, fundamentally, a tool for finding counterexamples to properties. QuickCheck generally cannot prove that a property holds for all possible inputs, because the domain may be infinite. That's the reason why there's an EqProp class in checkers ("Types of values that can be tested for equality, perhaps through random sampling")—so that we may implement techniques for searching for counterexamples for types and tests that don't admit of simple equality comparisons.

Inference rules for subsequence order

I am doing some exercises with the subsequence order,
record _⊑₀_ {X : Set} (xs ys : List X) : Set where
field
indices : Fin (length xs) → Fin (length ys)
embed : ∀ {a b : Fin (length xs)} → a < b → indices a < indices b
eq : ∀ {i : Fin (length xs)} → xs ‼ i ≡ ys ‼ (indices i)
where
_‼_ : ∀ {X : Set} → (xs : List X) → Fin (length xs) → X
[] ‼ ()
(x ∷ xs) ‼ fzero = x
(x ∷ xs) ‼ fsuc i = xs ‼ i
is the usual safe lookup.
Now while the record version is nice, I'd like to use inference rules instead as that's probably easier than constructing embeddings and proving properties about them each time.
So I try the following,
infix 3 _⊑₁_
data _⊑₁_ {X : Set} : (xs ys : List X) → Set where
nil : ∀ {ys} → [] ⊑₁ ys
embed : ∀ {x y} → x ≡ y → x ∷ [] ⊑₁ y ∷ []
cons : ∀ {xs₁ ys₁ xs₂ ys₂} → xs₁ ⊑₁ ys₁ → xs₂ ⊑₁ ys₂ → xs₁ ++ xs₂ ⊑₁ ys₁ ++ ys₂
Which looks promising. Though I have had trouble proving it to be a sound and complete reflection of the record version.
Anyhow, the subsequence order is transitive, and this is a bit of trouble:
⊑₁-trans : ∀ {X : Set} (xs ys zs : List X) → xs ⊑₁ ys → ys ⊑₁ zs → xs ⊑₁ zs
⊑₁-trans .[] ys zs nil q = nil
⊑₁-trans ._ ._ [] (embed x₁) q = {! q is absurd !}
⊑₁-trans ._ ._ (x ∷ zs) (embed x₂) q = {!!}
⊑₁-trans ._ ._ zs (cons p p₁) q = {!!}
We get unification errors when pattern matching on a seemingly impossible pattern q. So I have tried other data versions of the order that avoid this unification error but then other proofs have seemingly-absurd patterns lying around.
I'd like some help with a data version of the subsequence order (with soundness and completeness proofs, that'd be nice).
Are there any general heuristics to try when transforming a proposition in formula form into an inference/data form?
Thank-you!
We get unification errors when pattern matching on a seemingly
impossible pattern q.
That's the usual "green slime" problem. In the words of Conor McBride:
The presence of ‘green slime’ — defined functions in the return types
of constructors — is a danger sign.
See here for some techniques to beat the green slime.
For _⊑_ use order preserving embeddings:
infix 3 _⊑_
data _⊑_ {α} {A : Set α} : List A -> List A -> Set α where
stop : [] ⊑ []
skip : ∀ {xs ys y} -> xs ⊑ ys -> xs ⊑ y ∷ ys
keep : ∀ {xs ys x} -> xs ⊑ ys -> x ∷ xs ⊑ x ∷ ys
⊑-trans : ∀ {α} {A : Set α} {xs ys zs : List A} -> xs ⊑ ys -> ys ⊑ zs -> xs ⊑ zs
⊑-trans p stop = p
⊑-trans p (skip q) = skip (⊑-trans p q)
⊑-trans (skip p) (keep q) = skip (⊑-trans p q)
⊑-trans (keep p) (keep q) = keep (⊑-trans p q)

Theoretically, is this a valid comonad instance for a list?

I'm trying to grasp the concept of comonads, and after reading this blog post, I think I have a solid understand of what they do and how they are related to monads. But, I thought I would delve into the subject a little bit and just think about what the comonad instance of the generic list type (you know, [a]) would look like, and I've come to a piece I don't fully know is correct.
So, given the instance that the blog post used:
class Functor w => Comonad w where
(=>>) :: w a -> (w a -> b) -> w b
coreturn :: w a -> a
cojoin :: w a -> w (w a)
I thought that the instance declaration for [a] would look something like this (the syntax for [a] is probably either impossible or wrong, but you get the idea here):
instance Comonad [a] where
coreturn = head
cojoin = Data.List.subsequences --this is what I'm confused about
x =>> f = map f (cojoin x)
Here, we just find all of the subsequences of the list, but it would be entirely feasible to just use it's powerset or something. There are several functions on lists of the form (a -> [a]), and it's sort of ambiguous as to which one is correct.
Does this mean that [a] cannot be properly instantiated properly as a comonad, or is it simply up to the user to decide what cojoin will actually do?
As noted in the comments, you cannot have a comonad instance for lists that may be empty since coreturn has to return something.
Apart from that, your instance also has to satisfy the comonad laws. Expressed in terms of coreturn and cojoin, these are:
coreturn . cojoin = id
fmap coreturn . cojoin = id
cojoin . cojoin = fmap cojoin . cojoin
You can easily see that these do not hold for your instance even if we disallow empty lists. However, assuming that coreturn is head, we can use these laws to get some clues as to what cojoin must be.
From (1), we can determine that the first element of the list returned by cojoin must be the original list, and from (2) we see that combining the first elements of each inner list must also yield the original one. This strongly suggests that we need something like tails*, and it can be confirmed that this satisfies (3) as well.
* More specifically, we need a version of tails that does not include the empty list at the end.
To clarify upon what others have mentioned, consider the following type for non-empty lists:
data NonEmptyList a = One a | Many a (NonEmptyList a)
map :: (a -> b) -> NonEmptyList a -> NonEmptyList b
map f (One x) = One (f x)
map f (Many x xs) = Many (f x) (map f xs)
(++) :: NonEmptyList a -> NonEmptyList a -> NonEmptyList a
One x ++ ys = Many x ys
Many x xs ++ ys = Many x (xs ++ ys)
tails :: NonEmptyList a -> NonEmptyList (NonEmptyList a)
tails l#(One _) = One l
tails l#(Many _ xs) = Many l (tails xs)
You can write a valid comonad instance as follows:
instance Functor NonEmptyList where
fmap = map
instance Comonad NonEmptyList where
coreturn (One x) = x
coreturn (Many x xs) = x
cojoin = tails
-- this should be a default implementation
x =>> f = fmap f (cojoin x)
Let's prove the laws listed by hammar. I'll take the liberty of eta-expanding each one as a given first step.
Law 1.
(coreturn . cojoin) xs = id xs
-- definition of `.`, `cojoin`, and `id`
(coreturn (tails xs) = xs
-- case on xs
-- assume xs is (One x)
(coreturn (tails (One x))) = One x
-- definition of tails
(coreturn (One (One x))) = One x
-- definition of coreturn
One x = One x
-- assume xs is (Many y ys)
(coreturn (tails (Many y ys))) = Many y ys
-- definition of tails
(coreturn (Many (Many y ys) (tails ys)) = Many y ys
-- definition of coreturn
Many y ys = Many y ys
-- assume xs is _|_
(coreturn (tails _|_)) = _|_
-- tails pattern matches on its argument
(coreturn _|_) = _|_
-- coreturn pattern matches on its argument
_|_ = _|_
Law 2.
(fmap coreturn . cojoin) xs = id xs
-- definition of `.`, `cojoin`, `fmap`, and `id`
map coreturn (tails xs) = xs
-- case on xs
-- assume xs is (One x)
map coreturn (tails (One x)) = One x
-- defn of tails
map coreturn (One (One x)) = One x
-- defn of map
One (coreturn (One x)) = One x
-- defn of coreturn
One x = One x
-- assume xs is (Many y ys)
map coreturn (tails (Many y ys)) = Many y ys
-- defn of tails
map coreturn (Many (Many y ys) (tails ys)) = Many y ys
-- defn of map
Many (coreturn (Many y ys)) (map coreturn (tails ys)) = Many y ys
-- defn of coreturn
Many y (map coreturn (tail ys)) = Many y ys
-- eliminate matching portions
map coreturn (tail ys) = ys
-- wave hands.
-- If the list is not self-referential,
-- then this can be alleviated by an inductive hypothesis.
-- If not, then you can probably prove it anyways.
-- assume xs = _|_
map coreturn (tails _|_) = _|_
-- tails matches on its argument
map coreturn _|_ = _|_
-- map matches on its second argument
_|_ = _|_
Law 3.
(cojoin . cojoin) xs = (fmap cojoin . cojoin) xs
-- defn of `.`, `fmap`, and `cojoin`
tails (tails xs) = map tails (tails xs)
-- case on xs
-- assume xs = One x
tails (tails (One x)) = map tails (tails (One x))
-- defn of tails, both sides
tails (One (One x)) = map tails (One (One x))
-- defn of map
tails (One (One x)) = One (tails (One x))
-- defn of tails, both sides
One (One (One x)) = One (One (One x))
-- assume xs = Many y ys
(this gets ugly. left as exercise to reader)
-- assume xs = _|_
tails (tails _|_) = map tails (tails _|_)
-- tails matches on its argument
tails _|_ = map tails _|_
-- tails matches on its argument, map matches on its second argument
_|_ = _|_