haskell, the same program using monads - haskell

As you can see, I wrote program, e.g:
test "12 124 212" = Right [12, 124, 212]
test "43 243 fs3d 2" = Left "fs3d is not a number"
test :: String -> Either String [Int]
test w = iter [] $ words w
where
iter acc [] = Right (reverse acc)
iter acc (x:xs) = if (all isDigit x) then
iter ((read x):acc) xs
else
Left (x++ "is not a number")
A am starting learning monads. Could you show me how to implement it using monads ?

I think you are looking for traverse/mapM (they're the same for lists). Also you can use readEither for simplification:
import Data.Traversable (traverse)
import Data.Bifunctor (first)
import Text.Read (readEither)
test :: String -> Either String [Int]
test = traverse parseItem . words
parseItem :: String -> Either String Int
parseItem x = first (const $ x++" is not a number") $ readEither x
So what does mapM do? It basically implements the recursion over the list that you did manually. However, unlike the standard map function it takes a monadic function (parseItem in our case, where Either String is a monad) and applies one step on the list after the other:
iter [] = Right []
iter (x:xs) = do
r <- parseItem x
rs <- iter xs
return (r:rs)

Bergi's answer is just right, but maybe you'll find it easy to understand presented this way:
test :: String -> Either String [Int]
test str = traverse parseNumber (words str)
parseNumber :: String -> Either String Int
parseNumber str
| all isDigit str = Right (read str)
| otherwise = Left (str ++ " is not a number")
The other thing I'd recommend is don't write tail-recursive accumulator loops like iter in your example. Instead, look at library documentation and try to find list functions that do what you want. In this case, as Bergi correctly pointed out, traverse is exactly what you want. It will take some study to get fully comfortable with this function, though. But given how the Monad instance of Either and the Traversable instance of lists work, the traverse in this example works like this:
-- This is the same as `traverse` for lists and `Either`
traverseListWithEither :: (a -> Either err b) -> [a] -> Either err [b]
traverseListWithEither f [] = Right []
traverseListWithEither f (a:as) =
case f a of
Left err -> Left err
Right b -> mapEither (b:) (traverseListWithEither f as)
-- This is the same as the `fmap` function for `Either`
mapEither :: (a -> b) -> Either e a -> Either e b
mapEither f (Left e) = Left e
mapEither f (Right a) = Right (f a)

Related

Is there an easier way to write this function and only using prelude from Haskell?

So I'm pretty new to Haskell, and are trying to solve an assignment, I've solved it, but I'm wondering if there is an easier or prettier way to make a function do the same as my wordChange. I'm trying to only use what is already in prelude.
dictionaryChecker _ [] = False
dictionaryChecker word (x:xs) = if elem word (snd x) then True else dictionaryChecker word xs
wordChange :: String -> String
wordChange str = unwords (map (\s -> if length (translate s) > 0 then (translate s)
else if (dictionaryChecker s dictionary) then concat (replicate (length s) "*")
else s) (words str))
translate :: String -> String
translate str = contains str dictionary
contains _ [] = ""
contains str (x:xs) = if elem str (snd x) then fst x else contains str xs
I'd suggest to use the lookup function from Prelude, which takes a key and a list of tuples (a.k.a a dictionary) and returns Maybe value. This simplfies your function a lot. Also, if changeWord uses a dictionary, it should be explicit instead of using a global variable. Below, a partial solution: since it is an assignment I think you should try to complete it ;)
changeWord :: [(String, String)] -> String -> String
changeWord dic s = unwords $ substitute ws
where -- ws is just the list of words s has
ws = words s
-- the function substitute does the word changing recursively. Try to complete it
substitute [] = []
substitute (x:xs) =
case lookup x dic of -- look for x in the dictionary and returns the value if found
Nothing -> undefined --complete
Just y -> undefined --complete
An obfuscated answer: earn a gold star from your professor if you can explain how it works, and be accused of copying from the internet if you can't:
wordChange :: [(String, String)] -> String -> String
wordChange dict = unwords . map (foldr const <*> (`lookup` dict)) . words
Your dictionaryChecker is in essence an any :: Foldable f => (a -> Bool) -> f a -> Bool with elem word . snd as condition:
dictionaryChecker :: (Foldable f, Foldable g, Eq a) => a -> f (b, g a) -> Bool
dictionaryChecker word = any (elem word . snd)
as for a translate, we can work with a section of an infix operator [Haskell-wiki] to make a point-free function:
translate :: String -> String
translate = (`contains` dictionary)
and for contains we can work with a foldr :: Foldable f => (a -> b -> b) -> b -> f a -> b
contains :: (Foldable f, Foldable g, Eq a) => a -> f (String, g a) -> String
contains str = foldr (\x y -> if … then … else …) ""
I leave implementing the … parts as an exercise.

Is there a straight-forward solution to receiving the element *prior* to hitting the dropWhile predicate?

Given a condition, I want to search through a list of elements and return the first element that reaches the condition, and the previous one.
In C/C++ this is easy :
int i = 0;
for(;;i++) if (arr[i] == 0) break;
After we get the index where the condition is met, getting the previous element is easy, through "arr[i-1]"
In Haskell:
dropWhile (/=0) list gives us the last element I want
takeWhile (/=0) list gives us the first element I want
But I don't see a way of getting both in a simple manner. I could enumerate the list and use indexing, but that seems messy. Is there a proper way of doing this, or a way of working around this?
I would zip the list with its tail so that you have pairs of elements
available. Then you can just use find on the list of pairs:
f :: [Int] -> Maybe (Int, Int)
f xs = find ((>3) . snd) (zip xs (tail xs))
> f [1..10]
Just (3,4)
If the first element matches the predicate this will return
Nothing (or the second match if there is one) so you might need to special-case that if you want something
different.
As Robin Zigmond says break can also work:
g :: [Int] -> (Int, Int)
g xs = case break (>3) xs of (_, []) -> error "not found"
([], _) -> error "first element"
(ys, z:_) -> (last ys, z)
(Or have this return a Maybe as well, depending on what you need.)
But this will, I think, keep the whole prefix ys in memory until it
finds the match, whereas f can start garbage-collecting the elements
it has moved past. For small lists it doesn't matter.
I would use a zipper-like search:
type ZipperList a = ([a], [a])
toZipperList :: [a] -> ZipperList a
toZipperList = (,) []
moveUntil' :: (a -> Bool) -> ZipperList a -> ZipperList a
moveUntil' _ (xs, []) = (xs, [])
moveUntil' f (xs, (y:ys))
| f y = (xs, (y:ys))
| otherwise = moveUntil' f (y:xs, ys)
moveUntil :: (a -> Bool) -> [a] -> ZipperList a
moveUntil f = moveUntil' f . toZipperList
example :: [Int]
example = [2,3,5,7,11,13,17,19]
result :: ZipperList Int
result = moveUntil (>10) example -- ([7,5,3,2], [11,13,17,19])
The good thing about zippers is that they are efficient, you can access as many elements near the index you want, and you can move the focus of the zipper forwards and backwards. Learn more about zippers here:
http://learnyouahaskell.com/zippers
Note that my moveUntil function is like break from the Prelude but the initial part of the list is reversed. Hence you can simply get the head of both lists.
A non-awkward way of implementing this as a fold is making it a paramorphism. For general explanatory notes, see this answer by dfeuer (I took foldrWithTails from it):
-- The extra [a] argument f takes with respect to foldr
-- is the tail of the list at each step of the fold.
foldrWithTails :: (a -> [a] -> b -> b) -> b -> [a] -> b
foldrWithTails f n = go
where
go (a : as) = f a as (go as)
go [] = n
boundary :: (a -> Bool) -> [a] -> Maybe (a, a)
boundary p = foldrWithTails findBoundary Nothing
where
findBoundary x (y : _) bnd
| p y = Just (x, y)
| otherwise = bnd
findBoundary _ [] _ = Nothing
Notes:
If p y is true we don't have to look at bnd to get the result. That makes the solution adequately lazy. You can check that by trying out boundary (> 1000000) [0..] in GHCi.
This solution gives no special treatment to the edge case of the first element of the list matching the condition. For instance:
GHCi> boundary (<1) [0..9]
Nothing
GHCi> boundary even [0..9]
Just (1,2)
There's several alternatives; either way, you'll have to implement this yourself. You could use explicit recursion:
getLastAndFirst :: (a -> Bool) -> [a] -> Maybe (a, a)
getLastAndFirst p (x : xs#(y:ys))
| p y = Just (x, y)
| otherwise = getLastAndFirst p xs
getLastAndFirst _ [] = Nothing
Alternately, you could use a fold, but that would look fairly similar to the above, except less readable.
A third option is to use break, as suggested in the comments:
getLastAndFirst' :: (a -> Bool) -> [a] -> Maybe (a,a)
getLastAndFirst' p l =
case break p l of
(xs#(_:_), (y:_)) -> Just (last xs, y)
_ -> Nothing
(\(xs, ys) -> [last xs, head ys]) $ break (==0) list
Using break as Robin Zigmond suggested ended up short and simple, not using Maybe to catch edge-cases, but I could replace the lambda with a simple function that used Maybe.
I toyed a bit more with the solution and came up with
breakAround :: Int -> Int -> (a -> Bool) -> [a] -> [a]
breakAround m n cond list = (\(xs, ys) -> (reverse (reverse take m (reverse xs))) ++ take n ys) $ break (cond) list
which takes two integers, a predicate, and a list of a, and returns a single list of m elements before the predicate and n elements after.
Example: breakAround 3 2 (==0) [3,2,1,0,10,20,30] would return [3,2,1,0,10]

Elegant way to return the longer of two strings

I'm trying to write a function that returns the longer of two strings. So far this is what I have:
maxString :: String -> String -> String
maxString a b
| (length a) > (length b) = a
| otherwise = b
This works, but I'm wondering if there is a more elegant way to write this. Note: the two arguments cannot be in a list. They must be separate arguments to allow for currying.
Thoughts?
So far all answers except Tejing's fully traverse both arguments. This one only traverses as far as the end of the shorter one.
longest a b = l' a b where
l' _ [] = a
l' [] _ = b
l' (_:ar) (_:br) = l' ar br
Played around with this one a bit. I wanted it to be a one-liner as well as having complexity O(min(n,m)). (ie. working even with infinite lists)
maxList :: [a] -> [a] -> [a]
maxList s s' = if s == zipWith const s s' then s' else s
You can use existing Haskell facilities in Data.Ord and Data.Function and obtain a one-liner as follows:
maxString' x y = maximumBy (compare `on` length) [x, y]
Code:
import Data.Ord
import Data.Function
import Data.List
maxString' x y = maximumBy (compare `on` length) [x, y]
*Main> maxString' "ab" "c"
"ab"
-- EDIT --
As #DavidYoung pointed out,
compare `on` length
above can also be written in a shorter form: comparing length
That's pretty much the most concise way to write it. However, the version below will terminate even when one list is infinite (O(min(a,b)) instead of O(a + b)).
compareLengths :: [a] -> [b] -> Ordering
compareLengths [ ] [ ] = EQ
compareLengths (a:as) [ ] = GT
compareLengths [ ] (b:bs) = LT
compareLengths (a:as) (b:bs) = compareLengths as bs
maxList :: [a] -> [a] -> [a]
maxList a b = case compareLengths a b of
GT -> a
_ -> b
Also, there's no real reason to limit your function to just Strings when it would make sense for arbitrary lists.

Haskell sequencelistIO [a -> IO a] -> a -> IO a

I have the following problem:
I have a task to write a function taking a list of IO interactions and an initial value. The first action takes the initial value as an argument and the function shall pass its result (IO a) as an argument to the next interaction.
The latter expects data of type a, not IO a.
I don't get how to come over this obstacle.
Here is what I have:
seqList :: [a -> IO a] -> a -> IO a
seqList [] n = return n
seqList (inter:inters) n = do
val <- inter n
return $ seqList inters val
The problem is that val is of type (IO a) but the next IO expects a.
I tried something like
tmp <- unsafePerformIO val
after val <- ...
but that does not help and would be really bad style.
How can I solve this problem?
I want hints, no solutions,
thanks in advance.
EDIT
I edited it the following way:
seqList :: [a -> IO a] -> a -> IO a
seqList [] n = return n
seqList (inter:inters) n = do
val <- inter n
seqList inters val
as seqList inters val is already of the right type.
This should be ok or am I mistaken? It actually works for my examples.
I still am very new to this whole do-notation-monads-io-stuff as it seems.
Thank you very much for the hints.
The edited version is correct.
There's an interesting way of looking at this problem, though. One might analyze the type as follows
type Thing a = a -> IO a
seqList :: [Thing a] -> Thing a
In other words, seqList is a mechanism for combining Things. If we rewrite your working code a bit we can emphasize this.
seqList :: [Thing a] -> Thing a
seqList [] n = neutralThing n
seqList (thingHere : restOfThings) n = do
let remainingThing = seqList restOfThings
val <- thingHere
remainingThing val
neutralThing :: Thing a
neutralThing a = return a
In particular, I've isolated three parts
The neutral thing which is returned when the input list is empty
The recursive bit which computes the "remaining thing" from the tail of the list
The actual do-notation bit which "combines" things.
We can go even further
seqList :: [Thing a] -> Thing a
seqList [] = neutralThing
seqList (thingHere : restOfThings) =
combineThings thingHere (seqList restOfThings)
neutralThing :: Thing a
neutralThing a = return a
combineThings :: Thing a -> Thing a -> Thing a
combineThings thing1 thing2 n = do
n' <- thing1 n
n'' <- thing2 n'
return n''
Now we can recognize a general pattern: seqList is just a fold over the list.
seqList :: [Thing a] -> Thing a
seqList = foldr combineThings neutralThing
If we recognize that folds often expose Monoids we can also detect how Thing a is a monoid for any choice of a
memptyThing :: Thing a
memptyThing = neutralThing
mappendThing :: Thing a -> Thing a -> Thing a
mappendThing = combineThings
Finally, if we're really clever, we can note that Thing inherits it monoidalness from the slightly more general construction of a Category—in particular, something called the Kleisli IO category. If we were to use the Kleisli type itself there would be a lot of wrapping and unwrapping, but instead we can examine the types of return and (>=>) from Control.Monad.
return :: Monad m => a -> m a
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
With a little care we can see that these types are compatible with memptyThing and mappendThing. So, an ultimate solution to your problem is as follows
seqList :: [Thing a] -> Thing a
seqList = foldr (>=>) return
and we can finally note that this has a more general type if we like
seqList :: Monad m => [a -> m a] -> (a -> m a)
seqList = foldr (>=>) return
Another way to think of it is this: if you had two such actions, how would you chain them together? There's an operator in the Control.Monad library that does that. It shouldn't be too hard to understand:
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
f >=> g = \a -> do
b <- f a
g b
And if you have that operator, then you can write seqList by taking the the list of actions and basically putting >=> between all of them. The standard foldr function, will do the trick; as the documentation says it does precisely that:
foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
So put those together, plus return for the empty list case, and you get:
import Control.Monad ((>=>))
seqList :: [a -> IO a] -> a -> IO a
seqList actions = foldr (>=>) return actions
Whose behavior can be described by these equations:
foldr (>=>) return [] == return
foldr (>=>) return [x1, ..., xn] == x1 >=> ... >=> xn >=> return
And let's work it out in more detail! The definition of foldr is this:
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr _ z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
So using that, we can rewrite my definition of seqList as such:
-- Use the definition of `foldr` to split this into two cases
seqList [] = return
seqList (action:actions) = action >=> foldr (>=>) return actions
-- Use the definition of `>=>` to spell out the second equation
seqList [] = return
seqList (action:actions) = \a -> do
val <- action a
foldr (>=>) return actions val
-- But by the definition of `seqList`, we can rewrite the last line
-- to this:
seqList [] = return
seqList (action:actions) = \a -> do
val <- action a
seqList actions val
And that's what you wrote on your second try!
Some hints:
Consider the case of having exactly 2 functions in your list and have a look at >=>.
Have a look at the Endo monoid, in particular at the signature of its mconcat. Try replacing Endo a with a -> a in the signature.
How would the instance of the monadic generalization of Endo
newtype EndoM m a = EndoM { appEndoM :: a -> m a }
look like? What would be its mempty and mappend? What would be its mconcat?

Circular programming - replace list elements by minimum value

I've just read this article about circular programming. It seems so alien to me. Although I can imagine the feedback as lazily evaluated thunk that will be evaluated to desired result later, just can't wrap my head around it. So I decided to write function that replaces every element of a list with it's minimum value.
trace :: (a -> c -> (b,c)) -> a -> b
trace f a = b
where (b,c) = f a c
repminList :: (Num a, Ord a) => [a] -> [a]
repminList = trace repIIminList
repIIminList [x] m = ([m], x)
repIIminList (a:as) m = let (replaced, m) = repIIminList as m
in (m : replaced, min a m)
But repminList [1,2,3] equals to [2,3,3]. What would be the correct version?
Your problem is that you have two different m variables and one shadows over the other so you don't end up using the actual circular variable at all. Here's the fixed version of your repIIminList:
repIIminList [x] m = ([m], x)
repIIminList (a:as) m = let (replaced, m') = repIIminList as m
in (m : replaced, min a m')
Here m is the final, smallest element of the list that you receive as circular parameter. The m' returned from the recursive call to repIIminList is the smallest value seen so far, so it's important that you append the final smallest value (i.e. m) to the result list and then update the current smallest value by returning min a m'.
That's a pretty cool technique! Here's a working program that's inspired by yours (I didn't really read the article except to glance at the picture, so this may not be exactly what the author intended, but it works):
looper :: (inputT -> feedfwdT -> feedbackT -> (feedbackT, outputT)) -> inputT -> feedfwdT -> outputT
looper f input primer = output
where (feedback, output) = f input primer feedback
min_feedback :: (Ord a) => [a] -> Maybe a -> a -> (a, [a])
min_feedback [] (Just p) _ = (p, [])
min_feedback (x:xs) partial_min minimum = (feedback, minimum:output)
where new_partial_min = case partial_min
of Nothing -> Just x
Just p -> Just $ min x p
(feedback, output) = min_feedback xs new_partial_min minimum
min_looped :: (Ord a) => [a] -> [a]
min_looped input = looper min_feedback input Nothing
main = print $ min_looped [1,4,6,2,6,3,-1,6,3,6,10]
The key here is that you need more than the feedback channel, you also need a feedforward channel to determine the minimum value on the first pass through the loop. My ASCII art skills are not up to the standard set in the article, so you'll just have to make do with this paint drawing:
The feedforward is the minimum value seen so far in the list. The primer kickstarts the feedforward channel. The feedback channel takes the result value from the feedforward channel back up to the start of the list. Finally the feedback value becomes the minimum value that gets used to fill the output list.
It's
repIIminList (x:[]) m' = ([m'], x)
repIIminList (x:xs) m' = (m' : xs', min x m) where (xs', m) = repIIminList xs m'
m is a current minimum, m' is a final minimum, xs is a current list, xs' is a final list. That is, repIIminList receives a list and a number and recursively replaces every element in a list with this number. repIIminList also computes the minimum of the list. trace applies repIIminList to the minimum, computed by repIIminList itself.
Using the state monad you can rewrite this in a pretty explicit way:
repminList :: [Int] -> [Int]
repminList [] = []
repminList (x:xs) = evalState (go xs) x where
go [] = get >>= return . (:[])
go (x:xs) = modify (min x) >> flip (:) <$> go xs <*> get
Or using CPS style directly:
repminList :: [Int] -> [Int]
repminList [] = []
repminList (x:xs) = foldr (\x r -> (\(x:xs) -> x:x:xs) . r . min x) (:[]) xs x
I'm too tired to analyze your code, divine your intent and the bug. However, I'll happily show you how I avoid having to think that hard when doing basic knot tying.
Its this State Monad, yay! My use of the State monad (below) is just a little plumbing that keeps track of a single current value in a manner that allows the value to be looked-up and updated.
repMin kicks off the computation by taking into account the empty list then running the state monad.
Our worker action f is provided with the input list and the minimum element in the list (currently a thunk, do not evaluate!)
f traverses the list computing the minimum on the way and replacing each element with the soon-to-be-known-but-not-yet-evaluatable minimum value m.
The code:
import Control.Monad.State
repMin :: [Int] -> [Int]
repMin [] = []
repMin xs#(x:_) = let (v,m) = runState (f m xs) x in v
f :: Int -> [Int] -> State Int [Int]
f m xs = mapM (λx -> checkMin x >> return m) xs
where
checkMin :: Int -> State Int ()
checkMin x = modify (min x)
Notice there's a lazyness leak here wrt our huge thunk of min a (min b ( min c ...))), but you get the picture.

Resources