Non-empty-list comonad - list

I have been meditating on comonads and have an intuition that a non-empty list ("full list") is a comonad. I have constructed a plausible implementation in Idris and have worked on proving the comonad laws but have not been able to prove the recursive branch of one of the laws. How do I prove this (the ?i_do_not_know_how_to_prove_this_if_its_provable hole)--or am I wrong about my implementation being a valid comonad (I've looked at the Haskell NonEmpty comonad implementation and it seems to be the same as mine)?
module FullList
%default total
data FullList : Type -> Type where
Single : a -> FullList a
Cons : a -> FullList a -> FullList a
extract : FullList a -> a
extract (Single x) = x
extract (Cons x _) = x
duplicate : FullList a -> FullList (FullList a)
duplicate = Single
extend : (FullList a -> b) -> FullList a -> FullList b
extend f (Single x) = Single (f (Single x))
extend f (Cons x y) = Cons (f (Cons x y)) (extend f y)
extend_and_extract_are_inverse : (l : FullList a) -> extend FullList.extract l = l
extend_and_extract_are_inverse (Single x) = Refl
extend_and_extract_are_inverse (Cons x y) = rewrite extend_and_extract_are_inverse y in Refl
comonad_law_1 : (l : FullList a) -> extract (FullList.extend f l) = f l
comonad_law_1 (Single x) = Refl
comonad_law_1 (Cons x y) = Refl
nesting_extend : (l : FullList a) -> extend f (extend g l) = extend (\x => f (extend g x)) l
nesting_extend (Single x) = Refl
nesting_extend (Cons x y) = ?i_do_not_know_how_to_prove_this_if_its_provable

Notice that your goal is of the following form:
Cons (f (Cons (g (Cons x y)) (extend g y))) (extend f (extend g y)) =
Cons (f (Cons (g (Cons x y)) (extend g y))) (extend (\x1 => f (extend g x1)) y)
You basically need to prove that the tail parts are equal:
extend f (extend g y) = extend (\x1 => f (extend g x1)) y
But that is exactly what the induction hypothesis (nesting_extend y) says! Hence, the proof is quite trivial:
nesting_extend : (l : FullList a) -> extend f (extend g l) = extend (f . extend g) l
nesting_extend (Single x) = Refl
nesting_extend (Cons x y) = cong $ nesting_extend y
I used the congruence lemma cong:
cong : (a = b) -> f a = f b
which says that any function f maps equal terms into equal terms.
Here Idris infers that f is Cons (f (Cons (g (Cons x y)) (extend g y))), where the f inside Cons refers to nesting_extend's parameter f.

Related

Understanding function which implements foldr and foldl

There is some case where I don't understand how foldr and foldl are used in function.
Here is a couple of example, I then explain why I don't understand them:
-- Two implementation of filter and map
map' f = foldr (\x acc -> (f x):acc) []
map'' f xs = foldl (\acc x -> acc ++ [(f x)]) [] xs
filter' f xs = foldr(\x acc -> if(f x) then x:acc else acc) [] xs
filter'' f = foldl(\acc x -> if(f x) then acc++[x] else acc) []
Why does map'' makes the use of xs but non map'? Shouldn't map' need a list for the list comprehension formula as well?
Same case for filter' vs filter''.
Here is an implementation which insert elements in a sorted sequence:
insert e [] = [e]
insert e (x:xs)
| e > x = x: insert e xs
| otherwise = e:x:xs
sortInsertion xs = foldr insert [] xs
sortInsertion'' xs = foldl (flip insert) [] xs
Why are the argument for insert flipped in sortInsertion ([] xs) (empty list and list) compare to the definition of insert(e []) (element and empty list)
Why does map'' makes the use of xs but non map'? Shouldn't map' need a list for the list comprehension formula as well? Same case for filter' vs filter''.
This is called “eta-reduction” and it’s a common way of omitting redundant parameter names (“point-free style”). Essentially whenever you have a function whose body is just an application of a function to its argument, you can reduce away the argument:
add :: Int -> Int -> Int
add x y = x + y
-- “To add x and y, call (+) on x and y.”
add :: (Int) -> (Int) -> (Int)
add x y = ((+) x) y
-- “To add x, call (+) on x.”
add :: (Int) -> (Int -> Int)
add x = (+) x
-- “To add, call (+).”
add :: (Int -> Int -> Int)
add = (+)
More precisely, if you have f x = g x where x does not appear in g, then you can write f = g.
A common mistake is then wondering why f x = g . h x can’t be written as f = g . h. It doesn’t fit the pattern because the (.) operator is the top-level expression in the body of f: it’s actually f x = (.) g (h x). You can write this as f x = (((.) g) . h) x and then reduce it to f = (.) g . h or f = fmap g . h using the Functor instance for ->, but this isn’t considered very readable.
Why are the argument for insert flipped in sortInsertion
The functional parameters of foldr and foldl have different argument order:
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
Or, with more verbose type variable names:
foldr
:: (Foldable container)
=> (element -> accumulator -> accumulator)
-> accumulator -> container element -> accumulator
foldl
:: (Foldable container)
=> (accumulator -> element -> accumulator)
-> accumulator -> container element -> accumulator
This is just a mnemonic for the direction that the fold associates:
foldr f z [a, b, c, d]
==
f a (f b (f c (f d z))) -- accumulator on the right (second argument)
foldl f z [a, b, c, d]
==
f (f (f (f z a) b) c) d -- accumulator on the left (first argument)
That is partial function application.
map' f = foldr (\x acc -> (f x):acc) []
is just the same as
map' f xs = foldr (\x acc -> (f x):acc) [] xs
if you omit xs on both sides.
However, beside this explanation, I think you need a beginner book for Haskell. Consider LYAH.

How to implement a function using bind (>>=)

I wrote a filter function:
f :: (a -> Bool) -> [a] -> [a]
f p xs = case xs of
[] -> []
x : xs' -> if p x
then x : f p xs'
else f p xs'
To understand bind, I want to implement this using bind.
What I was thinking about:
f p xs = xs >>= (\x xs -> if p x then x : f p xs else f p xs)
But I get this error:
* Couldn't match expected type `[a]' with actual type `[a] -> [a]'
* The lambda expression `\ x xs -> ...' has two arguments,
but its type `a -> [a]' has only one
In the second argument of `(>>=)', namely
`(\ x xs -> if p x then x : f p xs else f p xs)'
In the expression:
xs >>= (\ x xs -> if p x then x : f p xs else f p xs)
* Relevant bindings include
xs :: [a] (bound at <interactive>:104:5)
p :: a -> Bool (bound at <interactive>:104:3)
f :: (a -> Bool) -> [a] -> [a] (bound at <interactive>:104:1)
Successfully did it using foldr:
f p xs = foldr (\x xs -> if p x then x : f p xs else f p xs) [] xs
What's going wrong?
To understand bind, i want to implement this as bind.
There is no bind here. The bind is added in case of a do expression. The above is not a do-expression, so there is no bind here.
You can however write this with bind, like:
f p xs = xs >>= \x -> if p x then [x] else []
but this is not a literal mapping of the original function, we simply make use of the instance Monad [] implementation here. Nevertheless, your f is just filter :: (a -> Bool) -> [a] -> [a] here.
To understand bind, first implement the no-op:
id_list xs = concat [ [x] | x <- xs ] = [ y | x <- xs, y <- [x ] ]
Now for the filter, augment it as
filter p xs = concat [ [x | p x] | x <- xs ] = [ y | x <- xs, y <- [x | p x] ]
How is this code using bind, you ask? If we're using MonadComprehensions, it does.
The explicit do-notation re-write is straightforward:
id_list xs = do { x <- xs ; y <- [ x ] ; return y }
filter p xs = do { x <- xs ; y <- [ x | p x] ; return y }
And of course, for lists,
[x] == return x
[x | p x] == if p x then return x else mzero
mzero == []
concat == join
This brings us back to an explicitly recursive way to code filter as
filter p [] = []
filter p (x:xs) = [x | p x] ++ filter p xs
With bind, we think in terms of transforming each element of the list individually, into the list of results (none, one, or several) for that one input element. Your foldr-based code breaks this.
So, the code itself is just
filter_bind p xs = xs >>= (\x -> [x | p x])
because we have
xs >>= f == join (fmap f xs)
== concat (map f xs)
== concat [ f x | x <- xs ]
== foldr (++) []
[ f x | x <- xs ]
with the last snippet corresponding to the explicitly recursive definition above.
See also
How does the List monad work in this example?
Haskell Monad - How does Monad on list work?
etc.

Swap two elements in a list by its indices

Is there any way to swap two elements in a list if the only thing I know about the elements is the position at which they occur in the list.
To be more specific, I am looking for something like this:
swapElementsAt :: Int -> Int -> [Int] -> [Int]
that would behave like that:
> swapElementsAt 1 3 [5,4,3,2,1] -- swap the first and third elements
[3,4,5,2,1]
I thought that a built-in function for this might exists in Haskell but I wasn't able to find it.
Warning: differential calculus. I don't intend this answer entirely seriously, as it's rather a sledgehammer nutcracking. But it's a sledgehammer I keep handy, so why not have some sport? Apart from the fact that it's probably rather more than the questioner wanted to know, for which I apologize. It's an attempt to dig out the deeper structure behind the sensible answers which have already been suggested.
The class of differentiable functors offers at least the following bits and pieces.
class (Functor f, Functor (D f)) => Diff (f :: * -> *) where
type D f :: * -> *
up :: (I :*: D f) :-> f
down :: f :-> (f :.: (I :*: D f))
I suppose I'd better unpack some of those definitions. They're basic kit for combining functors. This thing
type (f :-> g) = forall a. f a -> g a
abbreviates polymorphic function types for operations on containers.
Here are constant, identity, composition, sum and product for containers.
newtype K a x = K a deriving (Functor, Foldable, Traversable, Show)
newtype I x = I x deriving (Functor, Foldable, Traversable, Show)
newtype (f :.: g) x = C {unC :: f (g x)} deriving (Functor, Foldable, Traversable, Show)
data (f :+: g) x = L (f x) | R (g x) deriving (Functor, Foldable, Traversable, Show)
data (f :*: g) x = f x :*: g x deriving (Functor, Foldable, Traversable, Show)
D computes the derivative of a functor by the usual rules of calculus. It tells us how to represent a one-hole context for an element. Let's read the types of those operations again.
up :: (I :*: D f) :-> f
says we can make a whole f from the pair of one element and a context for that element in an f. It's "up", because we're navigating upward in a hierarchical structure, focusing on the whole rather than one element.
down :: f :-> (f :.: (I :*: D f))
Meanwhile, we can decorate every element in a differentiable functor structure with its context, computing all the ways to go "down" to one element in particular.
I'll leave the Diff instances for the basic components to the end of this answer. For lists we get
instance Diff [] where
type D [] = [] :*: []
up (I x :*: (xs :*: ys)) = xs ++ x : ys
down [] = C []
down (x : xs) = C ((I x :*: ([] :*: xs)) :
fmap (id *:* ((x :) *:* id)) (unC (down xs)))
where
(*:*) :: (f a -> f' a) -> (g a -> g' a) -> (f :*: g) a -> (f' :*: g') a
(ff' *:* gg') (f :*: g) = ff' f :*: gg' g
So, for example,
> unC (down [0,1,2])
[I 0 :*: ([] :*: [1,2]),I 1 :*: ([0] :*: [2]),I 2 :*: ([0,1] :*: [])]
picks out each element-in-context in turn.
If f is also Foldable, we get a generalized !! operator...
getN :: (Diff f, Foldable f) => f x -> Int -> (I :*: D f) x
getN f n = foldMap (: []) (unC (down f)) !! n
...with the added bonus that we get the element's context as well as the element itself.
> getN "abcd" 2
I 'c' :*: ("ab" :*: "d")
> getN ((I "a" :*: I "b") :*: (I "c" :*: I "d")) 2
I "c" :*: R ((I "a" :*: I "b") :*: L (K () :*: I "d"))
If we want a functor to offer swapping of two elements, it had better be twice differentiable, and its derivative had better be foldable too. Here goes.
swapN :: (Diff f, Diff (D f), Foldable f, Foldable (D f)) =>
Int -> Int -> f x -> f x
swapN i j f = case compare i j of
{ LT -> go i j ; EQ -> f ; GT -> go j i } where
go i j = up (I y :*: up (I x :*: f'')) where
I x :*: f' = getN f i -- grab the left thing
I y :*: f'' = getN f' (j - 1) -- grab the right thing
It's now easy to grab two elements out and plug them back in the other way around. If we're numbering the positions, we just need to be careful about the way removing elements renumbers the positions.
> swapN 1 3 "abcde"
"adcbe"
> swapN 1 2 ((I "a" :*: I "b") :*: (I "c" :*: I "d"))
(I "a" :*: I "c") :*: (I "b" :*: I "d")
As ever, you don't have do dig down too far below a funny editing operation to find some differential structure at work.
For completeness. Here are the other instances involved in the above.
instance Diff (K a) where -- constants have zero derivative
type D (K a) = K Void
up (_ :*: K z) = absurd z
down (K a) = C (K a)
instance Diff I where -- identity has unit derivative
type D I = K ()
up (I x :*: K ()) = I x
down (I x) = C (I (I x :*: K ()))
instance (Diff f, Diff g) => Diff (f :+: g) where -- commute with +
type D (f :+: g) = D f :+: D g
up (I x :*: L f') = L (up (I x :*: f'))
up (I x :*: R g') = R (up (I x :*: g'))
down (L f) = C (L (fmap (id *:* L) (unC (down f))))
down (R g) = C (R (fmap (id *:* R) (unC (down g))))
instance (Diff f, Diff g) => Diff (f :*: g) where -- product rule
type D (f :*: g) = (D f :*: g) :+: (f :*: D g)
up (I x :*: (L (f' :*: g))) = up (I x :*: f') :*: g
up (I x :*: (R (f :*: g'))) = f :*: up (I x :*: g')
down (f :*: g) = C (fmap (id *:* (L . (:*: g))) (unC (down f))
:*: fmap (id *:* (R . (f :*:))) (unC (down g)))
instance (Diff f, Diff g) => Diff (f :.: g) where -- chain rule
type D (f :.: g) = (D f :.: g) :*: D g
up (I x :*: (C f'g :*: g')) = C (up (I (up (I x :*: g')) :*: f'g))
down (C fg) = C (C (fmap inner (unC (down fg)))) where
inner (I g :*: f'g) = fmap wrap (unC (down g)) where
wrap (I x :*: g') = I x :*: (C f'g :*: g')
Haskell doesn't have such a function, mainly because it is a little bit un-functional. What are you actually trying to achieve?
You can implement your own version of it (maybe there is a more idiomatic way to write this). Note that I assume that i < j, but it would be trivial to extend the function to correctly handle the other cases:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt i j xs = let elemI = xs !! i
elemJ = xs !! j
left = take i xs
middle = take (j - i - 1) (drop (i + 1) xs)
right = drop (j + 1) xs
in left ++ [elemJ] ++ middle ++ [elemI] ++ right
There are several working answers here, but I thought that a more idiomatic haskell example would be useful.
In essence, we zip an infinite sequence of natural numbers with the original list to include ordering information in the first element of the resulting pairs, and then we use a simple right fold (catamorphism) to consume the list from the right and create a new list, but this time with the correct elements swapped. We finally extract all the second elements, discarding the first element containing the ordering.
The indexing in this case is zero-based (congruent with Haskell's typical indexes) and the pointers must be in range or you'll get an exception (this can be easily prevented if you change the resulting type to Maybe [a]).
swapTwo :: Int -> Int -> [a] -> [a]
swapTwo f s xs = map snd . foldr (\x a ->
if fst x == f then ys !! s : a
else if fst x == s then ys !! f : a
else x : a) [] $ ys
where ys = zip [0..] xs
And a single liner, doing the swap in just one pass (combining the functionality of the foldr and map into a zipWith):
swapTwo' f s xs = zipWith (\x y ->
if x == f then xs !! s
else if x == s then xs !! f
else y) [0..] xs
That's how I solved it:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt a b list = list1 ++ [list !! b] ++ list2 ++ [list !! a] ++ list3
where list1 = take a list;
list2 = drop (succ a) (take b list);
list3 = drop (succ b) list
Here I used the convention that position 0 is the first. My function expects a<=b.
What I like most in my program is the line take a list.
Edit: If you want to get more such cool lines, look at this code:
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt a another list = list1 ++ [list !! another] ++ list2 ++ [list !! a] ++ list3
where list1 = take a list;
list2 = drop (succ a) (take another list);
list3 = drop (succ another) list
first-order one-pass swapping
swap 1 j l = let (jth,ith:l') = swapHelp j l ith in jth:l'
swap j 1 l = swap 1 j l
swap i j (h:t) = h : swap (i-1) (j-1) t
swapHelp 1 (h:t) x = (h,x:t)
swapHelp n (h:t) x = (y,h:t') where
(y, t') = swapHelp (n-1) t x
now with precondition in compliance with original question, i.e. relaxed to 1 <= i,j <= length l for swap i j l
draws heavily on an idea by #dfeuer to reduce the problem to swapping the 1st element of a list with another from a given position
This is a strange thing to do, but this should work, aside from the off-by-one errors you'll have to fix since I'm writing this on my phone. This version avoids going over the same segments of the list any more times than necessary.
swap' :: Int -> Int -> [a] -> [a]
swap' first second lst = beginning ++ [y] ++ middle ++ [x] ++ end
where
(beginning, (x : r)) = splitAt first lst
(middle, (y : end)) = splitAt (second - first - 1) r
swap x y | x == y = id
| otherwise = swap' (min x y) (max x y)
There is also a recursive solution:
setElementAt :: a -> Int -> [a] -> [a]
setElementAt a 0 (_:tail) = a:tail
setElementAt a pos (b:tail) = b:(setElementAt a (pred pos) tail)
swapElementsAt :: Int -> Int -> [a] -> [a]
swapElementsAt 0 b list#(c:tail) = (list !! b):(setElementAt c (pred b) tail)
swapElementsAt a b (c:tail) = c:(swapElementsAt (pred a) (pred b) tail)
I really like #dfeuer 's solution. However there's still room for optimization by way of deforestation:
swap' :: Int -> Int -> [a] -> [a]
swap' first second lst = beginning $ [y] ++ (middle $ [x] ++ end)
where
(beginning, (x : r)) = swapHelp first lst
(middle, (y : end)) = swapHelp (second - first - 1) r
swapHelp :: Int -> [a] -> ([a] -> [a],[a])
swapHelp 0 l = ( id , l)
swapHelp n (h:t) = ((h:).f , r) where
( f , r) = swapHelp (n-1) t
For positional swapping, using a more complex fold function I have changed the value of the smalest (min) index with the value of the greates (xs!!(y-ii)) and then keep the value for the greatest index in the temp, until find it, the index(max).
I used min and max to make sure I encounter in proper order the indices otherwise I would have to put more checks and conditions in the folds function.
folds _ _ _ _ [] = []
folds i z y tmp (x:xs)
| i == z = (xs!!(y-ii)):folds ii z y x xs
| i == y = tmp:folds ii z y 0 xs
| otherwise = x:folds ii z y tmp xs
where
ii = i+1
swapElementsAt x y xs = folds 0 a b 0 xs
where
a = min x y
b = max x y
Results
> swapElementsAt 0 1 [1,1,1,3,4,9]
[1,1,1,3,4,9]
> swapElementsAt 0 5 [1,1,1,3,4,9]
[9,1,1,3,4,1]
> swapElementsAt 3 1 [1,1,1,3,4,5]
[1,3,1,1,4,5]
> swapElementsAt 1 3 [1,1,1,3,4,5]
[1,3,1,1,4,5]
> swapElementsAt 5 4 [1,1,1,3,4,5]
[1,1,1,3,5,4]
Efficiency aside, we can do a fully recursive definition with only pattern matching.
swapListElem :: [a] -> Int -> Int -> [a]
-- Get nice arguments
swapListElem xs i j
| (i>= length xs) || (j>=length xs) = error "Index out of range"
| i==j = xs
| i>j = swapListElem xs j i
-- Base case
swapListElem (x:y:xs) 0 1 = (y:x:xs)
-- Base-ish case: If i=0, use i'=1 as a placeholder for j-th element
swapListElem (x:xs) 0 j = swapListElem (swapListElem (x:(swapListElem xs 0 (j-1))) 0 1) 1 j
-- Non-base case: i>0
swapListElem (x:xs) i j = x:(swapListElem xs (i-1) (j-1))

Generate all possibilities in scheme from a list

I have a list of sublists:
((a b c) (e f) (z h))
and i want to generate something like this:
((a e z) (a f z) (a e h) (a f h) (b e z) (b e h) ... ) and so on.
I want, given a list of sublist, to generate all possibilities of sublists that contains an element from each of the input's sublists.
How can i get this ouput?
You're describing the cartesian product of a list of lists, here's a possible implementation (works in Racket):
(define (cartesian-product lsts)
(foldr (lambda (lst acc)
(for*/list ((x (in-list lst))
(y (in-list acc)))
(cons x y)))
'(())
lsts))
Now, if you're not using Racket, here's a vanilla implementation using mostly standard procedures; it should work on any Scheme interpreter that defines a fold-right-like procedure:
(define (flatmap f lst)
(apply append (map f lst)))
(define (cartesian-product lsts)
(foldr (lambda (lst acc)
(flatmap (lambda (x)
(map (lambda (y)
(cons x y))
acc))
lst))
'(())
lsts))
Either way, it works as expected:
(cartesian-product '((a b c) (e f) (z h)))
=> '((a e z) (a e h) (a f z) (a f h) (b e z) (b e h)
(b f z) (b f h) (c e z) (c e h) (c f z) (c f h))

Lisp Move Elements in a List

I have a list of the form:
(or a b c (and d e) f g (and h i) (==> x y))
and I like to move the sublists beginning with and after the or like this:
(or (and d e) (and h i) a b c f g (==> x y))
How can I do this? I'm not sure what's the best way since it's a list and I can't just put an element whatever I want, like I can with other data structures.
? (stable-sort (rest '(or a b c (and d e) f g (and h i) (==> x y)))
(lambda (x y)
(and (consp x) (eq (first x) 'and))))
((AND H I) (AND D E) A B C F G (==> X Y))