Prologs returns in haskell - 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) )))

Related

How to count the number of even integers in a list in Haskell with State monad?

I am trying to grok some of the fundamentals of the State Monad in Haskell, by constructing my own examples.
Consider a simple example where I want to count the number of even integers in an array of integers. Sure this can be done very easily using pure functions, but I wanted to try the round-about State monad route, where we keep a counter that keeps incrementing for every element that has been checked.
Here is a partial (but obviously wrong) attempt that I have managed to come up with thus far.
import Control.Monad.State
f' :: [Int] -> State Int [Int]
f' [] = state (\s -> ([],s))
f' (x:xs) = if x `mod` 2 == 0 then state (\s -> ((x:xs), s+1)) -- how can I fix this line?
else f' xs
This code compiles, but clearly does not give the right answer. How then can I fix this code, to do something similar to the following Python code
counter = 0 # incremented when we encounter an even integer.
for elt in integer_list:
if elt % 2 == 0 :
counter = counter + 1
The other answer starts from scratch to build up an implementation. I think it is also worth seeing a minimal change to your existing code to make it sensible. We will even keep your existing type -- though the other answer proposes that it be changed, I think it is acceptable (if not great).
In my opinion, the real problem is that you have recursed only in one branch of your if. What we really want is to recurse whether or not the current element is even. So:
f' (x:xs) = do
if x `mod` 2 == 0 then state (\s -> ((), s+1)) -- increase the count by one
else state (\s -> ((), s )) -- don't increase the count by one
rest <- f' xs -- compute the answer for the rest of the list
return (x:rest) -- reconstruct the answer for the whole list
We can check that it does the right thing in ghci:
> runState (f' [1..5]) 0
([1,2,3,4,5],2)
This is just about the smallest change you can make to get your implementation idea working.
From there, I would suggest a number of refactorings. First, your pervasive use of state is a code smell. I would write the various uses in this way instead:
f' [] = return []
f' (x:xs) = do
if x `mod` 2 == 0 then modify (+1) else return ()
rest <- f' xs
return (x:rest)
From here, I would use the even function in the conditional, and notice that the when function implements the "do some action or return ()" operation. So:
f' [] = return []
f' (x:xs) = do
when (even x) (modify (+1))
rest <- f' xs
return (x:rest)
Additionally, we actually have a combinator for running a monadic action on each element of a list; that is mapM. So we can turn the above explicit recursion into an implicit one in this way:
f' xs = mapM (\x -> when (even x) (modify (+1)) >> return x) xs
Finally, I think it a little bit odd that the function returns the list it consumed. Not unidiomatic, per se, as the previous objections have been, but maybe not what you want. If it turns out that you don't plan on using the resulting list in any followup computation, it will be more efficient to throw it away as you go; and the mapM_ combinator does this. So:
f' :: [Int] -> State Int ()
f' xs = mapM_ (\x -> when (even x) (modify (+1))) xs
At this point, I would consider f' to be quite a nice implementation of the idea you have proposed.
Let's get back to the drawing board. The actual function you want to use is something like
countEven :: [Int] -> Int
countEven xs = runStateMagic xs
where runStateMagic uses some State hidden in its depths. How could that function look like? Well, it has to use either execState or evalState. Since we're interested in the state only (aka, our current count of numbers), so let's replace runStateMagic with execState:
countEven :: [Int] -> Int
countEven xs = execState someState 0
Now, execState's type fixes our stateFunc to State Int a. The actual value type of the state is arbitrary, since we're not going to use it anyway. So what should someState do? It should probably work on the list, and use modify' (+1) if we have an even number. Let's write a helper for that:
increaseIfEven :: Int -> State Int ()
increaseIfEven n
| even n = modify' inc
| otherwise = return ()
This will now modify the state iff the number was even. All we have to do is to apply this to every element on the list. Therefore, for a list xs, we can simply do
mapM_ increaseIfEven xs
Remember, mapM_ :: (a -> m b) -> [a] -> m (). But in our case, that m is State Int, so it already contains our counter.
All in all, we end up with
countEven :: [Int] -> Int
countEven xs = execState (mapM_ increaseIfEven xs) 0
But keep in mind: the important part was to fix the type of the original function, f'.

How to get all subnumbers of a number in haskell

I would like to get all sub numbers of a number from a particular side.
In the case of the number 1234, the sub numbers from the left side are:
1, 12, 123, 1234
I implemented it with:
tail . inits $ show 1234
This way I get all the sub numbers in [[Char]] format.
["1","12","123","1234"]
I tried to convert them to Integer, with the following line.
map read . tail . inits $ show 1234
But I get the following error
[*** Exception: Prelude.read: no parse
What am I doing wrong?
because the interpreter does not know what type you want back
this will work:
λ> map read . tail . inits $ show 1234 :: [Int]
[1,12,123,1234]
of course you can just add a type-signature as well (most likely in your code file):
subnums :: Int -> [Int]
subnums = map read . tail . inits . show
in ghci:
λ> subnums 1234
[1,12,123,1234]
and a nice exercise can be to do this without show/read:
subnumbers :: Int -> [Int]
subnumbers 0 = []
subnumbers n =
n : subnumbers (n `div` 10)
Can you solve the problem with the order here?
A good approach is to use an unfold. While a fold (variously known as reduce, accumulate or aggregate in other languages) can process a list of numbers (or values of other types) to compute a single result value, an unfold starts with a single value and expands it into a list of values according to a given function. Let us examine the type of an unfold function:
Data.List.unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
We see that unfoldr take a function (b -> Maybe (a, b), and a starting b. The result is a [a]. If the function evaluates to Just (a, b), the a will be appended to the result, and the unfold recurses with the new b. If the function evaluates to Nothing, the unfold is complete.
The function for your unfold is:
f :: Integral b => b -> Maybe (b, b)
f x = if x > 0
then Just (x, x `div` 10) -- append x to result; continue with x/10
else Nothing -- x = 0; we're done
Now we can solve your problem without any of this show and read hackery:
λ> let f = (\x -> if x > 0 then Just (x, x `div` 10) else Nothing)
λ> reverse $ unfoldr f 1234
[1,12,123,1234]
As Carsten suggests, you need to give some indication of what type you want. This is because read is polymorphic in its result type. Until the compiler knows what type you want, it doesn't know what parser to use! An explicit type annotation is usually the way to go, but you might sometimes consider the function
asTypeOf :: a -> a -> a
asTypeOf x _ = x
how to use this here
I see two obvious ways to use asTypeOf here:
λ> asTypeOf (map read . tail . inits $ show 1234) ([0] :: [Int])
[1,12,123,1234]
and
λ> map (asTypeOf read length) . tail . inits $ show 1234
[1,12,123,1234]
the first one seems hardly better at all and the second might be a bit tricky for beginners - but it works ;)
Why? Because length has type [a] -> Int and so the result type will be fixed to Int:
λ> :t (`asTypeOf` length)
(`asTypeOf` length) :: ([a] -> Int) -> [a] -> Int
which is just what we need for read
Please note that it's not important what length does - only it's type is important - any other function with an compatible signature would have worked as well (although I can come up only with length right now)
For example:
wantInt :: [a] -> Int
wantInt = undefined
λ> map (asTypeOf read wantInt) . tail . inits $ show 1234
[1,12,123,1234]
A working list comprehension solution:
subNums :: Int -> [Int]
subNums num = [read x | let str = show num, let size = length str, n <- [1 .. size], let x = take n str]
λ> subNums 1234
[1,12,123,1234]

What's the name of the function that applies each function in a list of functions to a value progressively, accumulating the results?

It's like the title says. I've implemented this, but maybe this function already has a common name and exists in a standard library.
Other suggestions about this function are welcome. Maybe there is a cleaner implementation.
let transform x funcList = transform' x [x] funcList
where transform' startVal accum funcList
| null funcList = reverse accum
| otherwise = let result = (head funcList) startVal
in transform' result (result:accum) $ tail funcList
When executed, it does this:
> transform 2 [(2 + ),((-1) +),(3 *)]
[2,4,3,9]
You can define it with scanl:
let transform = scanl (\v f -> f v)
or
let transform = scanl (flip ($))
My suggestion isn't far as nice as the scanl one, but perhaps it can offer a different view on the problem. We're doing a state-ful traversal. We convert each function to a State value that takes an input, applies the function to it and returns the value as well as puts it as the next state. Then all we need to do is to mapM over the whole list.
import Control.Monad.State
trans :: a -> [a -> a] -> [a]
trans s fs = s : evalState (mapM toState fs) s
where
-- join (,) just makes a tuple out of a value
-- using the reader monad
toState = state . (join (,) .)

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.

Performance of "all" in haskell

I got nearly no knowledge of haskell and tried to solve some Project Euler Problems.
While solving Number 5 I wrote this solution (for 1..10)
--Check if n can be divided by 1..max
canDivAll :: Integer -> Integer -> Bool
canDivAll max n = all (\x -> n `mod` x == 0) [1..max]
main = print $ head $ filter (canDivAll 10) [1..]
Now I found out, that all is implemented like this:
all p = and . map p
Doesn't this mean, the condition is checked for every element? Wouldn't it be much faster to break upon the first False-Result of the condition? This would make the execution of the code above faster.
Thanks
and itself is short-circuited and since both map and all evaluation is lazy, you will only get as many elements as needed - not more.
You can verify that with a GHCi session:
Prelude Debug.Trace> and [(trace "first" True), (trace "second" True)]
first
second
True
Prelude Debug.Trace> and [(trace "first" False), (trace "second" False)]
first
False
map does not evaluate all its argument before and executes. And and is short-circuited.
Notice that in GHC all isn't really defined like this.
-- | Applied to a predicate and a list, 'all' determines if all elements
-- of the list satisfy the predicate.
all :: (a -> Bool) -> [a] -> Bool
#ifdef USE_REPORT_PRELUDE
all p = and . map p
#else
all _ [] = True
all p (x:xs) = p x && all p xs
{-# RULES
"all/build" forall p (g::forall b.(a->b->b)->b->b) .
all p (build g) = g ((&&) . p) True
#-}
#endif
We see that all p (x:xs) = p x && all p xs, so whenever p x is false, the evaluation will stop.
Moreover, there is a simplification rule all/build, which effectively transforms your all p [1..max] into a simple fail-fast loop*, so I don't think you can improve much from modifying all.
*. The simplified code should look like:
eftIntFB c n x0 y | x0 ># y = n
| otherwise = go x0
where
go x = I# x `c` if x ==# y then n else go (x +# 1#)
eftIntFB ((&&) . p) True 1# max#
This is a good program for the fusion optimization, as all your loops are expressed as fusible combinators. Thus you can write it using, e.g. Data.Vector, and get better performance than with lists.
From N=20, with lists as in your program:
52.484s
Also, use rem instead of mod.
15.712s
Where the list functions become vector operations:
import qualified Data.Vector.Unboxed as V
canDivAll :: Int -> Int -> Bool
canDivAll max n = V.all (\x -> n `rem` x == 0) (V.enumFromN 1 max)
main = print . V.head $ V.filter (canDivAll 20) $ V.unfoldr (\a -> Just (a, a+1)) 1
You're assuming that and is not short-circuiting. and will stop execution on the first false result it sees, so it is "fast" as one might expect.

Resources