Related
I want to apply a function over a list, but if, at any moment, a result returned by the function is of a certain kind, then I don't want to continue to iterate over the rest of the elements.
I know I could achieve this with this function:
example p f ls = takeWhile p $ map f ls
The thing is that I would like to know if it reached the end of the list, or if it failed to do so.
I thought of this function, but it seems a bit cumbersome:
haltmap :: Eq a => (a -> Bool) -> (b -> a) -> [a] -> [b] -> Either [a] [a]
haltmap _ _ acc [] = Right acc
haltmap p f acc (h:t)
| p output = Left acc
| otherwise = haltmap p f (acc ++ [output]) t
where output = f h
I use Left and Right to know if it went through the entire list or not.
I'm sure there's a better way to do that.
I'd use span for this. It's like takeWhile but it gives you a pair with the remainder of the list as well as the matching part, like this:
> span (<3) [1,2,3,2,1]
([1,2],[3,2,1])
Then you can check if the remainder is empty:
haltmap :: (a -> Bool) -> (b -> a) -> [b] -> Either [a] [a]
haltmap p f xs = (if null rest then Right else Left) ys
where
(ys, rest) = span p (map f xs)
You can use foldr for this. Because go does not evaluate the second argument unless needed, this will also work for infinite lists. (Will Ness also had an answer that also used foldr, but it seems they've deleted it).
import Data.Bifunctor (bimap)
haltmap :: Eq a => (b -> Bool) -> (a -> b) -> [a] -> Either [b] [b]
haltmap p f xs = foldr go (Right []) xs
where
go x a
| p output = let o = (output:) in bimap o o a
| otherwise = Left []
where output = f x
main = do
print $ haltmap (<5) (+1) [1..]
print $ haltmap (<12) (+1) [1..10]
Try it online!
Using a tuple with a Bool may be easier, though.
import Data.Bifunctor (second)
haltmap :: Eq a => (b -> Bool) -> (a -> b) -> [a] -> (Bool, [b])
haltmap p f xs = foldr go (True, []) xs
where
go x a
| p output = second (output:) a
| otherwise = (False, [])
where output = f x
haltmap (<5) (+1) [1..] //(False,[2,3,4])
haltmap (<12) (+1) [1..10] //(True,[2,3,4,5,6,7,8,9,10,11])
Try it online!
I found a solution with foldr, which is the following:
haltMap :: (a -> Bool) -> (b -> a) -> [b] -> Either [a] [a]
haltMap p f = foldr (\x acc -> if p x then Left []
else (either (\a -> Left (x:a)) (\b -> Right (x:b)) acc))
(Right []) . map f
Also, to return, instead of the partial list, the element which failed, all is needed it to change Left [] to Left x in the if clause, and change the (\a -> Left (x:a)) to Left in the else clause.
In recursion schemes, how can I construct something with type definition like (Recursive t, CoRecursive t) -> t -> ? -> t
I try to use recursion-schemes to update nodes. Taking list as an example, I can come up with two methods like:
update :: [a] -> Natural -> a -> [a]
update = para palg where
palg Nil _ _ = []
palg (Cons a (u, _)) 0 b = b : u
palg (Cons a (u, f)) n b = a : f (n-1) b
update' :: [a] -> Natural -> a -> [a]
update' = c2 (apo acoalg) where
c2 f a b c = f (a,b,c)
acoalg ([], _, _) = Nil
acoalg (_:as , 0, b) = Cons b $ Left as
acoalg (a:as , n, b) = Cons a $ Right (as, n-1, b)
However, these two implementations are good. In these two implementations, the constructor of ListF and [] appears in both sides of the equation. And the definition does not appear to be unique. Is there a better way to perform List update with recursion schemes?
Recursion schemes is flexible approach. You can also implement your own variant.
(Reuse cata)
zipo :: (Recursive g, Recursive h) => (Base g (h -> c) -> Base h h -> c) -> g -> h -> c
zipo alg = cata zalg
where
zalg x = alg x <<< project
update :: forall a. [a] -> Natural -> a -> [a]
update xs n a = zipo alg n xs
where
alg :: Maybe ([a] -> [a]) -> ListF a [a] -> [a]
alg _ Nil = []
alg Nothing (Cons y ys) = a:ys
alg (Just n') (Cons y ys) = y:(n' ys)
Also u can implement some parallel version like
zipCata :: (Recursive g, Recursive h) => ((g -> h -> r) -> Base g g -> Base h h -> r) -> g -> h -> r
zipCata phi x y = phi (zipCata phi) (project x) (project y)
update' :: forall a. [a] -> Natural -> a -> [a]
update' xs n a = zipCata alg n xs
where
alg :: (Natural -> [a] -> [a]) -> Maybe Natural -> ListF a [a] -> [a]
alg _ _ Nil = []
alg _ Nothing (Cons _ ys) = a:ys
alg f (Just n) (Cons y ys) = y:(f n ys)
Both variants (also as your) will be get the same result
PS. I hate approach for code sample on SO
I need a function that does this:
>>> func (+1) [1,2,3]
[[2,2,3],[2,3,3],[2,3,4]]
My real case is more complex, but this example shows the gist of the problem. The main difference is that in reality using indexes would be infeasible. The List should be a Traversable or Foldable.
EDIT: This should be the signature of the function:
func :: Traversable t => (a -> a) -> t a -> [t a]
And closer to what I really want is the same signature to traverse but can't figure out the function I have to use, to get the desired result.
func :: (Traversable t, Applicative f) :: (a -> f a) -> t a -> f (t a)
It looks like #Benjamin Hodgson misread your question and thought you wanted f applied to a single element in each partial result. Because of this, you've ended up thinking his approach doesn't apply to your problem, but I think it does. Consider the following variation:
import Control.Monad.State
indexed :: (Traversable t) => t a -> (t (Int, a), Int)
indexed t = runState (traverse addIndex t) 0
where addIndex x = state (\k -> ((k, x), k+1))
scanMap :: (Traversable t) => (a -> a) -> t a -> [t a]
scanMap f t =
let (ti, n) = indexed (fmap (\x -> (x, f x)) t)
partial i = fmap (\(k, (x, y)) -> if k < i then y else x) ti
in map partial [1..n]
Here, indexed operates in the state monad to add an incrementing index to elements of a traversable object (and gets the length "for free", whatever that means):
> indexed ['a','b','c']
([(0,'a'),(1,'b'),(2,'c')],3)
and, again, as Ben pointed out, it could also be written using mapAccumL:
indexed = swap . mapAccumL (\k x -> (k+1, (k, x))) 0
Then, scanMap takes the traversable object, fmaps it to a similar structure of before/after pairs, uses indexed to index it, and applies a sequence of partial functions, where partial i selects "afters" for the first i elements and "befores" for the rest.
> scanMap (*2) [1,2,3]
[[2,2,3],[2,4,3],[2,4,6]]
As for generalizing this from lists to something else, I can't figure out exactly what you're trying to do with your second signature:
func :: (Traversable t, Applicative f) => (a -> f a) -> t a -> f (t a)
because if you specialize this to a list you get:
func' :: (Traversable t) => (a -> [a]) -> t a -> [t a]
and it's not at all clear what you'd want this to do here.
On lists, I'd use the following. Feel free to discard the first element, if not wanted.
> let mymap f [] = [[]] ; mymap f ys#(x:xs) = ys : map (f x:) (mymap f xs)
> mymap (+1) [1,2,3]
[[1,2,3],[2,2,3],[2,3,3],[2,3,4]]
This can also work on Foldable, of course, after one uses toList to convert the foldable to a list. One might still want a better implementation that would avoid that step, though, especially if we want to preserve the original foldable type, and not just obtain a list.
I just called it func, per your question, because I couldn't think of a better name.
import Control.Monad.State
func f t = [evalState (traverse update t) n | n <- [0..length t - 1]]
where update x = do
n <- get
let y = if n == 0 then f x else x
put (n-1)
return y
The idea is that update counts down from n, and when it reaches 0 we apply f. We keep n in the state monad so that traverse can plumb n through as you walk across the traversable.
ghci> func (+1) [1,1,1]
[[2,1,1],[1,2,1],[1,1,2]]
You could probably save a few keystrokes using mapAccumL, a HOF which captures the pattern of traversing in the state monad.
This sounds a little like a zipper without a focus; maybe something like this:
data Zippy a b = Zippy { accum :: [b] -> [b], rest :: [a] }
mapZippy :: (a -> b) -> [a] -> [Zippy a b]
mapZippy f = go id where
go a [] = []
go a (x:xs) = Zippy b xs : go b xs where
b = a . (f x :)
instance (Show a, Show b) => Show (Zippy a b) where
show (Zippy xs ys) = show (xs [], ys)
mapZippy succ [1,2,3]
-- [([2],[2,3]),([2,3],[3]),([2,3,4],[])]
(using difference lists here for efficiency's sake)
To convert to a fold looks a little like a paramorphism:
para :: (a -> [a] -> b -> b) -> b -> [a] -> b
para f b [] = b
para f b (x:xs) = f x xs (para f b xs)
mapZippy :: (a -> b) -> [a] -> [Zippy a b]
mapZippy f xs = para g (const []) xs id where
g e zs r d = Zippy nd zs : r nd where
nd = d . (f e:)
For arbitrary traversals, there's a cool time-travelling state transformer called Tardis that lets you pass state forwards and backwards:
mapZippy :: Traversable t => (a -> b) -> t a -> t (Zippy a b)
mapZippy f = flip evalTardis ([],id) . traverse g where
g x = do
modifyBackwards (x:)
modifyForwards (. (f x:))
Zippy <$> getPast <*> getFuture
I've been trying to reproduce an aside mentioned in All Sorts of Permutations (Functional Pearl) by Christiansen, Danilenko and Dylus, a paper for the upcoming ICFP 2016. Section 8 (“Final Remarks”) claims that by choosing a particular non-deterministic predicate, a monadic merge sort can produce all permutations of a sequence in lexicographical order.
We did only consider the non-deterministic predicate coinCmp, while there are other non-deterministic predicates that can be used to affect the order of enumeration. For example, the following function lifts a predicate cmp to a non-deterministic context.
liftCmp :: MonadPlus μ
⇒ (α → α → Bool) → Cmp α μ
liftCmp p x y = return (p x y) ⊕ return (not (p x y))
When we use this function to lift a comparison function and pass it to a monadic version of merge sort, we get a special kind of permutation function: it enumerates permutations in lexicographical order.
I'm pretty sure what I've written here is merge sort, but when run the ordering isn't as advertised.
import Control.Applicative (Alternative((<|>)))
import Control.Monad (MonadPlus, join)
import Data.Functor.Identity (Identity)
-- Comparison in a context
type Comparison a m = a -> a -> m Bool
-- Ordering lifted into the Boring Monad
boringCmp :: (a -> a -> Bool) -> Comparison a Identity
boringCmp p x y = return (p x y)
-- Arbitrary ordering in a non-deterministic context
cmp :: MonadPlus m => Comparison a m
cmp _ _ = return True <|> return False
-- Ordering lifted into a non-deterministic context
liftCmp :: MonadPlus m => (a -> a -> Bool) -> Comparison a m
liftCmp p x y = let b = p x y in return b <|> return (not b)
mergeM :: Monad m => Comparison a m -> [a] -> [a] -> m [a]
mergeM _ ls [] = return ls
mergeM _ [] rs = return rs
mergeM p lls#(l:ls) rrs#(r:rs) = do
b <- p l r
if b
then (l:) <$> mergeM p ls rrs
else (r:) <$> mergeM p lls rs
mergeSortM :: Monad m => Comparison a m -> [a] -> m [a]
mergeSortM _ [] = return []
mergeSortM _ [x] = return [x]
mergeSortM p xs = do
let (ls, rs) = deinterleave xs
join $ mergeM p <$> mergeSortM p ls <*> mergeSortM p rs
where
deinterleave :: [a] -> ([a], [a])
deinterleave [] = ([], [])
deinterleave [l] = ([l], [])
deinterleave (l:r:xs) = case deinterleave xs of (ls, rs) -> (l:ls, r:rs)
λ mergeSortM (boringCmp (<=)) [2,1,3] :: Identity [Int]
Identity [1,2,3]
λ mergeSortM cmp [2,1,3] :: [[Int]]
[[2,3,1],[2,1,3],[1,2,3],[3,2,1],[3,1,2],[1,3,2]]
λ mergeSortM (liftCmp (<=)) [2,1,3] :: [[Int]]
[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
And the actual lexicographic ordering for reference—
λ sort it
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
Let's try a variant of deinterleave, which splits the first and last half of the list, instead of splitting even- and odd- indexed elements as in the posted code:
deinterleave :: [a] -> ([a], [a])
deinterleave ys = splitAt (length ys `div` 2) ys
Result:
> mergeSortM (liftCmp (<=)) [2,1,3] :: [[Int]]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
Unfortunately, this does not solve the issue as I first hoped, as Rowan Blush points out below. :-/
I wondered how to write f x = zip x (tail x) in point free. So I used the pointfree program and the result was f = ap zip tail. ap being a function from Control.Monad
I do not understand how the point free definition works. I hope I can figure it out if I can comprehend it from the perspective of types.
import Control.Monad (ap)
let f = ap zip tail
let g = ap zip
:info ap zip tail f g
ap :: Monad m => m (a -> b) -> m a -> m b
-- Defined in `Control.Monad'
zip :: [a] -> [b] -> [(a, b)] -- Defined in `GHC.List'
tail :: [a] -> [a] -- Defined in `GHC.List'
f :: [b] -> [(b, b)] -- Defined at <interactive>:3:5
g :: ([a] -> [b]) -> [a] -> [(a, b)]
-- Defined at <interactive>:4:5
By looking at the expression ap zip tail I would think that zip is the first parameter of ap and tail is the second parameter of ap.
Monad m => m (a -> b) -> m a -> m b
\--------/ \---/
zip tail
But this is not possible, because the types of zip and tail are completely different than what the function ap requires. Even with taking into consideration that the list is a monad of sorts.
So the type signature of ap is Monad m => m (a -> b) -> m a -> m b. You've given it zip and tail as arguments, so let's look at their type signatures.
Starting with tail :: [a] -> [a] ~ (->) [a] [a] (here ~ is the equality operator for types), if we compare this type against the type of the second argument for ap,
(->) [x] [x] ~ m a
((->) [x]) [x] ~ m a
we get a ~ [x] and m ~ ((->) [x]) ~ ((->) a). Already we can see that the monad we're in is (->) [x], not []. If we substitute what we can into the type signature of ap we get:
(((->) [x]) ([x] -> b)) -> (((->) [x]) [x]) -> (((->) [x]) b)
Since this is not very readable, it can more normally be written as
([x] -> ([x] -> b)) -> ([x] -> [x]) -> ([x] -> b)
~ ([x] -> [x] -> b ) -> ([x] -> [x]) -> ([x] -> b)
The type of zip is [x] -> [y] -> [(x, y)]. We can already see that this lines up with the first argument to ap where
[x] ~ [x]
[y] ~ [x]
[(x, y)] ~ b
Here I've listed the types vertically so that you can easily see which types line up. So obviously x ~ x, y ~ x, and [(x, y)] ~ [(x, x)] ~ b, so we can finish substituting b ~ [(x, x)] into ap's type signature and get
([x] -> [x] -> [(x, x)]) -> ([x] -> [x]) -> ([x] -> [(x, x)])
-- zip tail ( ap zip tail )
-- ap zip tail u = zip u (tail u)
I hope that clears things up for you.
EDIT: As danvari pointed out in the comments, the monad (->) a is sometimes called the reader monad.
There are two aspects to understanding this:
The type magic
The information flow of the implementation
Firstly, this helped me understand the type magic:
1) zip : [a] → ( [a] → [(a,a)] )
2) tail : [a] → [a]
3) zip <*> tail : [a] → [(a,a)]
4) <*> : Applicative f ⇒ f (p → q) → f p → f q
In this case, for <*>,
5) f x = y → x
Note that in 5, f is a type constructor. Applying f to x produces a type. Also, here = is overloaded to mean equivalence of types.
y is currently a place-holder, in this case, it is [a], which means
6) f x = [a] -> x
Using 6, we can rewrite 1,2 and 3 as follows:
7) zip : f ([a] → [(a,a)])
8) tail : f [a]
9) zip <*> tail : f ([a] → [(a,a)]) → f [a] → f [(a,a)]
So, looking at 4, we are substituting as follows:
10) p = [a]
11) q = [(a,a)]
12) f x = [a] → x
(Repetition of 6 here again as 12 )
Secondly, the information flow, i.e. the actual functionality. This is easier, it is clear from the definition of <*> for the Applicative instance of y →, which is rewritten here with different identifier names and using infix style:
13) g <*> h $ xs = g xs (h xs)
Substituting as follows:
14) g = zip
15) h = tail
Gives:
zip <*> tail $ xs (Using 14 and 15)
==
zip xs (tail xs) (Using 13 )