Maybe bails out of fold - haskell

Why does computing the following expression terminate?
foldr (\x t -> if x > 5 then Just x else t) Nothing $ [1..]
Is there anything special about Maybe (or one of the type classes it implements) that causes evaluation to stop after the lambda returns a Just?

Maybe ,Just, and Nothing play no active role here. What we see is just laziness at work. Indeed, for any (total) function f and value a, this would also terminate:
foldr (\x t -> if x > 5 then f x else t) a $ [1..]
This is perfectly equivalent to the plain recursion
foo [] = a
foo (x:xs) = if x > 5 then f x else foo xs
when called as foo [1..]. Eventually, x becomes 6, f 6 is returned, and no more recursive calls are made.

Related

Recursive state monad for accumulating a value while building a list?

I'm totally new to Haskell so apologies if the question is silly.
What I want to do is recursively build a list while at the same time building up an accumulated value based on the recursive calls. This is for a problem I'm doing for a Coursera course, so I won't post the exact problem but something analogous.
Say for example I wanted to take a list of ints and double each one (ignoring for the purpose of the example that I could just use map), but I also wanted to count up how many times the number '5' appears in the list.
So to do the doubling I could do this:
foo [] = []
foo (x:xs) = x * 2 : foo xs
So far so easy. But how can I also maintain a count of how many times x is a five? The best solution I've got is to use an explicit accumulator like this, which I don't like as it reverses the list, so you need to do a reverse at the end:
foo total acc [] = (total, reverse acc)
foo total acc (x:xs) = foo (if x == 5 then total + 1 else total) (x*2 : acc) xs
But I feel like this should be able to be handled nicer by the State monad, which I haven't used before, but when I try to construct a function that will fit the pattern I've seen I get stuck because of the recursive call to foo. Is there a nicer way to do this?
EDIT: I need this to work for very long lists, so any recursive calls need to be tail-recursive too. (The example I have here manages to be tail-recursive thanks to Haskell's 'tail recursion modulo cons').
Using State monad it can be something like:
foo :: [Int] -> State Int [Int]
foo [] = return []
foo (x:xs) = do
i <- get
put $ if x==5 then (i+1) else i
r <- foo xs
return $ (x*2):r
main = do
let (lst,count) = runState (foo [1,2,5,6,5,5]) 0 in
putStr $ show count
This is a simple fold
foo :: [Integer] -> ([Integer], Int)
foo [] = ([], 0)
foo (x : xs) = let (rs, n) = foo xs
in (2 * x : rs, if x == 5 then n + 1 else n)
or expressed using foldr
foo' :: [Integer] -> ([Integer], Int)
foo' = foldr f ([], 0)
where
f x (rs, n) = (2 * x : rs, if x == 5 then n + 1 else n)
The accumulated value is a pair of both the operations.
Notes:
Have a look at Beautiful folding. It shows a nice way how to make such computations composable.
You can use State for the same thing as well, by viewing each element as a stateful computation. This is a bit overkill, but certainly possible. In fact, any fold can be expressed as a sequence of State computations:
import Control.Monad
import Control.Monad.State
-- I used a slightly non-standard signature for a left fold
-- for simplicity.
foldl' :: (b -> a -> a) -> a -> [b] -> a
foldl' f z xs = execState (mapM_ (modify . f) xs) z
Function mapM_ first maps each element of xs to a stateful computation by modify . f :: b -> State a (). Then it combines a list of such computations into one of type State a () (it discards the results of the monadic computations, just keeps the effects). Finally we run this stateful computation on z.

Prologs returns in haskell

I'm rewritting my Prolog program in Haskell and i have small problem, how can i do something like that
myFunc(Field, Acc, Acc) :-
% some "ending" condition
!.
myFunc(Field, Acc, Result) :-
nextField(Field, Field2),
test1(Field2,...),
myFunc(Field2, Acc, Result).
myFunc(Field, Acc, Result) :-
nextField(Field, Field2),
test2(Ak, (X1, Y1)),
myFunc(Field2, [Field2|Acc], Result).
in Haskell? Code above is checking some condition and recursivly calls itself so in the end i get list of specific fields. The whole point is that if some condition (test1 or test2) fails, it is returning to the last point it could make other choice and does it. How do i implement something like that in Haskell?
To model Prolog computations as expressively in Haskell, you need a backtracking monad. This is trivially done using the LogicT monad. Your example as it stands translates to the following:
import Control.Monad.Logic
myFunc :: Int -> [Int] -> Logic [Int]
myFunc field acc = ifte (exitCond field acc) (\_-> return acc) $
(do f <- nextField field
guard $ test1 f
myFunc f acc)
`mplus`
(do f <- nextField field
guard $ test2 f
myFunc f (f:acc))
Assuming the following implementations for the functions and predicates:
nextField i = return (i+1)
test1 f = f < 10
test2 f = f < 20
exitCond f a = guard (f > 15)
You use mplus to combine to Logic computations so that if one fails it backtracks and tries the other one. ifte is just a soft cut (there's no hard cut in logict, although I believe it's trivial to implement since logict is based on continuations) to exit when the exiting condition is true. You run your computation as follows:
Main> runLogic (myFunc 1 []) (\a r -> a:r) []
[[16,15,14,13,12,11,10],[16,15,14,13,12,11,10,9],[16,15,14,13,12,11,10,8]...
runLogic takes the Logic computation, a continuation and an initial value for the output of the continuation. Here I just passed a continuation which will accumulate all results in a list. The above will backtrack and get all solutions, unlike the Prolog example, since we used a soft cut instead of a hard cut. To stop backtracking after getting the first solution you can use once:
Main> runLogic (once $ myFunc 1 []) (\a r -> a:r) []
[[16,15,14,13,12,11,10]]
you can also use observe to observe the first solution only, without having to pass a continuation:
Main> observe (myFunc 1 [])
[16,15,14,13,12,11,10]
or even obserMany and observeAll:
observeMany 5 (myFunc 1 []) --returns the first 5 solutions
observerAll (myFunc 1 []) --returns a list of all solutions
Finally, you will need to install the logict package to get the above code to work. Use cabal install logict to install it.
Edit: Answering your question in the comments
Yes, you can do something similar without having to install logict. Although a dedicated backtracking monad makes things less complicated and makes clear what you are trying to do.
To model the logict example above you only need the [] monad
myFunc :: Int -> [Int] -> [[Int]]
myFunc field acc | exitCond field acc = return acc
myFunc field acc = do
let m1 = do
f <- nextField field
guard $ test1 f
myFunc f acc
m2 = do
f <- nextField field
guard $ test2 f
myFunc f (f:acc)
in m1 `mplus` m2
nextField i = return $ i + 1
exitCond i a = i > 15
test1 i = i < 10
test2 i = i < 20
You can run it as follows:
Main> myFunc 1 []
[[16,15,14,13,12,11,10],[16,15,14,13,12,11,10,9],[16,15,14,13,12,11,10,8]...
You can also choose how many solutions you want as before:
Main> head $ myFunc 1 []
[16,15,14,13,12,11,10]
Main> take 3 $ myFunc 1 []
[[16,15,14,13,12,11,10],[16,15,14,13,12,11,10,9],[16,15,14,13,12,11,10,8]]
However, you will need the Cont monad, and thus the ListT monad, to implement a hard cut as in the Prolog example, which was not available in the logict example above:
import Control.Monad.Cont
import Control.Monad.Trans.List
myFunc :: Int -> ListT (Cont [[Int]]) [Int]
myFunc field = callCC $ \exit -> do
let g field acc | exitCond field acc = exit acc
g field acc =
let m1 = do
f <- nextField field
guard $ test1 f
g f acc
m2 = do
f <- nextField field
guard $ test2 f
g f (f:acc)
in m1 `mplus` m2
g field []
Like Prolog, this last example will not backtrack again after exitCond is satisfied:
*Main> runCont (runListT (myFunc 1)) id
[[16,15,14,13,12,11,10]]
You comment helped clarify some, but there is still some question in mind about what you are looking for so here is an example of using the list monad and guard.
import Control.Monad
myFunc lst = do
e <- lst
guard $ even e -- only allow even elements
guard . not $ e `elem` [4,6,8] -- do not allow 4, 6, or 8
return e -- accumulate results
used in ghci:
> myFunc [1..20]
[2,10,12,14,16,18,20]
I've never programmed in Haskell - then I would call for your help - but could hint about
that Prolog fragment - where I think you have a typo - should be myFunc(Field2, [(X1,Y1)|Acc], Result). could be compiled -by hand - in a continuation passing schema.
Let's google about it (haskell continuation passing prolog). I will peek first the Wikipedia page: near Haskell we find the continuation monad.
Now we can try to translate that Prolog in executable Haskell. Do this make sense ?
Textual translation of your code to Haskell is:
myFunc field acc = take 1 $ -- a cut
g field acc
where
g f a | ending_condition_holds = [a]
g f a =
( nextField f >>= (\f2 ->
(if test1 ... -- test1 a predicate function
then [()]
else [] ) >>= (_ ->
g f2 a )))
++
( nextField f >>= (\f2 ->
test2 ... >>= (\_ -> -- test2 producing some results
g f2 (f2:a) )))

Is my rewritten foldl function optimised?

I just started Haskell 2 days ago so I'm not yet sure about how to optimise my code.
As an exercise, I have rewritten foldl and foldr ( I will give foldl here but foldr is the same, replacing last with head and init with tail).
The code is:
module Main where
myFoldl :: ( a -> ( b -> a ) ) -> a -> ( [b] -> a )
myFoldl func = ( \x -> (\theList
-> if (length theList == 0) then
x
else
myFoldl func (func x (last theList) ) (init theList)
) )
My only concern is that I suspect Haskell can't apply tail call optimisation here because the recursive call is not made at the end of the function.
How can I make this tail call optimised? Is Haskell's built-in implementation of foldl implemented differently to mine?
Your use of parentheses in your code sample and your emphasis on tail recursion suggests you're coming to Haskell from Lisp or Scheme. If you're coming to Haskell from an eager language like Scheme, be warned: tail calls are not nearly as predictive of performance in Haskell as they are in an eager language. You can have tail-recursive functions that execute in linear space because of laziness, and you can have non-tail recursive functions that execute in constant space because of laziness. (Confused already?)
First flaw in your definition is the use of the length theList == 0. This forces evaluation of the whole spine of the list, and is O(n) time. It's better to use pattern matching, like in this naïve foldl definition in Haskell:
foldl :: (b -> a -> b) -> b -> [a] -> b
foldl f z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
This, however, performs infamously badly in Haskell, because we don't actually compute the f z x part until the caller of foldl demands the result; so this foldl accumulates unevaluated thunks in memory for each list element, and gains no benefit from being tail recursive. In fact, despite being tail-recursive, this naïve foldl over a long list can lead to a stack overflow! (The Data.List module has a foldl' function that doesn't have this problem.)
As a converse to this, many Haskell non-tail recursive functions perform very well. For example, take this definition of find, based on the accompanying non-tail recursive definition of foldr:
find :: (a -> Boolean) -> [a] -> Maybe a
find pred xs = foldr find' Nothing xs
where find' elem rest = if pred elem then Just elem else rest
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z [] = z
foldr f z (x:xs) = f x (subfold xs)
where subfold = foldr f z
This actually executes in linear time and constant space, thanks to laziness. Why?
Once you find an element that satisfies the predicate, there is no need to traverse the rest of the list to compute the value of rest.
Once you look at an element and decide that it doesn't match, there's no need to keep any data about that element.
The lesson I'd impart right now is: don't bring in your performance assumptions from eager languages into Haskell. You're just two days in; concentrate first on understanding the syntax and semantics of the language, and don't contort yourself into writing optimized versions of functions just yet. You're going to get hit with the foldl-style stack overflow from time to time at first, but you'll master it in time.
EDIT [9/5/2012]: Simpler demonstration that lazy find runs in constant space despite not being tail recursive. First, simplified definitions:
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
find :: (a -> Bool) -> [a] -> Maybe a
find p xs = let step x rest = if p x then Just x else rest
in foldr step Nothing xs
Now, using equational reasoning (i.e., substituting equals with equals, based on the definition above), and evaluating in a lazy order (outermost first), let's calculate find (==400) [1..]:
find (==400) [1..]
-- Definition of `find`:
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing [1..]
-- `[x, y, ...]` is the same as `x:[y, ...]`:
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing (1:[2..])
-- Using the second equation in the definition of `foldr`:
=> let step x rest = if x == 400 then Just x else rest
in step 1 (foldr step Nothing [2..])
-- Applying `step`:
=> let step x rest = if x == 400 then Just x else rest
in if 1 == 400 then Just 1 else foldr step Nothing [2..]
-- `1 == 400` is `False`
=> let step x rest = if x == 400 then Just x else rest
in if False then Just 1 else foldr step Nothing [2..]
-- `if False then a else b` is the same as `b`
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing [2..]
-- Repeat the same reasoning steps as above
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing (2:[3..])
=> let step x rest = if x == 400 then Just x else rest
in step 2 (foldr step Nothing [3..])
=> let step x rest = if x == 400 then Just x else rest
in if 2 == 400 then Just 2 else foldr step Nothing [3..]
=> let step x rest = if x == 400 then Just x else rest
in if False then Just 2 else foldr step Nothing [3..]
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing [3..]
.
.
.
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing [400..]
=> let step x rest = if x == 400 then Just x else rest
in foldr step Nothing (400:[401..])
=> let step x rest = if x == 400 then Just x else rest
in step 400 (foldr step Nothing [401..])
=> let step x rest = if x == 400 then Just x else rest
in if 400 == 400 then Just 400 else foldr step Nothing [401..]
=> let step x rest = if x == 400 then Just x else rest
in if True then Just 400 else foldr step Nothing [401..]
-- `if True then a else b` is the same as `a`
=> let step x rest = if x == 400 then Just x else rest
in Just 400
-- We can eliminate the `let ... in ...` here:
=> Just 400
Note that the expressions in the successive evaluation steps don't get progressively more complex or longer as we proceed through the list; the length or depth of the expression at step n is not proportional to n, it's basically fixed. This in fact demonstrates how find (==400) [1..] can be lazily executed in constant space.
Idiomatic Haskell looks very different to this, eschewing if-then-else, nested lambdas, parentheses, and destructuring functions (head, tail). Instead, you'd write it something like:
foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f z0 xs0 = go z0 xs0
where
go z [] = z
go z (x:xs) = go (f z x) xs
Relying instead on pattern matching, a where clause, tail recursion, guarded declarations.

Trying to write a function point free, GHCI does not approve

As an exercise I'm trying to implement interesting parts of the prelude manually. Whenever I spot an opportunity to go point free I take it. However this has led me to a brick wall in the most unlikely place. Using this code:
myelem _ [] = False
myelem x y = if x == head y then True else myelem x (tail y)
I am trying to implement notElem. Here are my attempts:
-- First
mynotelem = not myelem
Understandably blows up due to the types not matching up. This is easily fixed:
-- Second
mynotelem x y = not (myelem x y)
However the explicit declaration of arguments x and y feels ugly and unnecessary, so I try to get it back into point free style.
-- Third
mynotelem = not $ myelem
Which fails with
Couldn't match expected type `Bool'
with actual type `a0 -> [a0] -> Bool'
In the second argument of `($)', namely `myelem'
In the expression: not $ myelem
In an equation for `mynotelem': mynotelem = not $ myelem
Fair enough, the types still don't match up. But how do you fix it? Again you can jump straight to
-- Fourth
mynotelem x y = not $ myelem x y
Which works, but seems dangerously close to just going in circles. I discover it's possible to eliminate one of the arguments:
-- Fifth
mynotelem x = not . (myelem x)
But that pesky x still remains. How do I eliminate it?
We can rewrite your code like this:
mynotelem x = not . (myelem x)
= (not .) (myelem x)
Now recognize that this is just h x = f (g x) with f = (not .) and g = myelem, so we can write it point-free with another use of the (.) operator as h = f . g:
mynotelem = (not .) . myelem
Note how the pattern continues when composing with functions with more arguments:
> let f x y z = x+y+z
> (((sqrt .) .) . f) 1 2 3
2.449489742783178
Alternatively, you can also write it with this funny-looking composition of composition operators:
mynotelem = ((.).(.)) not myelem
For more arguments, the pattern continues like this:
> ((.).(.).(.)) sqrt f 1 2 3
2.449489742783178

Fixed point combinator in Haskell

The fixed point combinator doesn't always produce the right answer given the definition:
fix f = f (fix f)
The following code does not terminate:
fix (\x->x*x) 0
Of course, fix can't always produce the right answer, but I was wondering, can this be improved?
Certainly for the above example, one can implement some fix that looks like
fix f x | f x == f (f x) = f x
| otherwise = fix f (f x)
and gives the correct output.
What is the reason the above definition (or something even better, as this one only handle function with 1 parameter) is not used instead?
Fixed point combinator finds the least-defined fixed point of a function, which is ⊥ in your case (non-termination indeed is undefined value).
You can check, that in your case
(\x -> x * x) ⊥ = ⊥
i.e. ⊥ really is fixed point of \x -> x * x.
As for why is fix defined that way: the main point of fix is to allow you use anonymous recursion and for that you do not need more sophisticated definition.
Your example does not even typecheck:
Prelude> fix (\x->x*x) 0
<interactive>:1:11:
No instance for (Num (a0 -> t0))
arising from a use of `*'
Possible fix: add an instance declaration for (Num (a0 -> t0))
In the expression: x * x
In the first argument of `fix', namely `(\ x -> x * x)'
In the expression: fix (\ x -> x * x) 0
And that gives the clue as to why it doesn't work as you expect. The x in your anonymous function is supposed to be a function, not a number. The reason for this is, as Vitus suggests, that a fixpoint combinator is a way to write recursion without actually writing recursion. The general idea is that a recursive definition like
f x = if x == 0 then 1 else x * f (x-1)
can be written as
f = fix (\f' x -> if x == 0 then 1 else x * f' (x-1))
Your example
fix (\x->x*x) 0
thus corresponds to the expression
let x = x*x in x 0
which makes no sense.
I'm not entirely qualified to talk about what the "fixpoint combinator" is, or what the "least fixed point" is, but it is possible to use a fix-esque technique to approximate certain functions.
Translating Scala by Example section 4.4 to Haskell:
sqrt' :: Double -> Double
sqrt' x = sqrtIter 1.0
where sqrtIter guess | isGoodEnough guess = guess
| otherwise = sqrtIter (improve guess)
improve guess = (guess + x / guess) / 2
isGoodEnough guess = abs (guess * guess - x) < 0.001
This function works by repeatedly "improving" a guess until we determine that it is "good enough". This pattern can be abstracted:
myFix :: (a -> a) -- "improve" the guess
-> (a -> Bool) -- determine if a guess is "good enough"
-> a -- starting guess
-> a
fixApprox improve isGoodEnough startGuess = iter startGuess
where iter guess | isGoodEnough guess = guess
| otherwise = iter (improve guess)
sqrt'' :: Double -> Double
sqrt'' x = myFix improve isGoodEnough 1.0
where improve guess = (guess + x / guess) / 2
isGoodEnough guess = abs (guess * guess - x) < 0.001
See also Scala by Example section 5.3. fixApprox can be used to approximate the fixed point of the improve function passed into it. It repeatedly invokes improve on the input until the output isGoodEnough.
In fact, you can use myFix not only for approximations, but for exact answers as well.
primeAfter :: Int -> Int
primeAfter n = myFix improve isPrime (succ n)
where improve = succ
isPrime x = null [z | z <- [2..pred x], x `rem` z == 0]
This is a pretty dumb way to generate primes, but it illustrates the point. Hm...now I wonder...does something like myFix already exist? Stop...Hoogle time!
Hoogling (a -> a) -> (a -> Bool) -> a -> a, the very first hit is until.
until p f yields the result of applying f until p holds.
Well there you have it. As it turns out, myFix = flip until.
You probably meant iterate:
*Main> take 8 $ iterate (^2) (0.0 ::Float)
[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]
*Main> take 8 $ iterate (^2) (0.001 ::Float)
[1.0e-3,1.0000001e-6,1.0000002e-12,1.0000004e-24,0.0,0.0,0.0,0.0]
*Main> take 8 $ iterate (^2) (0.999 ::Float)
[0.999,0.99800104,0.9960061,0.9920281,0.9841198,0.96849173,0.93797624,0.8797994]
*Main> take 8 $ iterate (^2) (1.0 ::Float)
[1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0]
*Main> take 8 $ iterate (^2) (1.001 ::Float)
[1.001,1.002001,1.0040061,1.0080284,1.0161213,1.0325024,1.0660613,1.1364866]
Here you have all the execution history explicitly available for your analysis. You can attempt to detect the fixed point with
fixed f from = snd . head
. until ((< 1e-16).abs.uncurry (-).head) tail
$ _S zip tail history
where history = iterate f from
_S f g x = f x (g x)
and then
*Main> fixed (^2) (0.999 :: Float)
0.0
but trying fixed (^2) (1.001 :: Float) will loop indefinitely, so you'd need to develop separate testing for convergence, and even then detection of repellent fixed points like 1.0 will need more elaborate investigation.
You can't define fix the way you've mentioned since f x may not even be comparable. For instance, consider the example below:
myFix f x | f x == f (f x) = f x
| otherwise = myFix f (f x)
addG f a b =
if a == 0 then
b
else
f (a - 1) (b + 1)
add = fix addG -- Works as expected.
-- addM = myFix addG (Compile error)

Resources