I want to make a function, that changes certain value according to the passed letter. (These are basically given directions: East, West....)
The code is :
data Movement = N Int | S Int | E Int | W Int deriving (Eq, Show)
step :: Movement -> (Int, Int) -> (Int, Int)
step (Movement x h) (y, z)
| x == N = (y, z+h)
| x == S = (y, z-h)
| x == W = (y-h, z)
| x == E = (y+h, z)
An Example:
step (N 1) (239, 578) == (239, 579)
step (S 1) (240, 578) == (240, 577)
step (W 1) (239, 578) == (238, 578)
step (E 1) (239, 577) == (240, 577)
step (N 61) (239, 578) == (239,639)
step (N 2) (-4, 0) == (-4, 2)
step (E 1) (-4, 0) == (-3, 0)
step (S (-61)) (239, 578) == (239,639)
I am keep getting
Not in scope: data constructor `Movement'
error message.
Movement is a type, not a value. You can't use that in patterns.
Further, N and other constructors are functions, and you can't == functions.
You need to use pattern matching instead, and forget guards.
step :: Movement -> (Int, Int) -> (Int, Int)
step (N h) (y,z) = ...
step (S h) (y,z) = ...
step (W h) (y,z) = ...
step (E h) (y,z) = ...
Alternatively, refactor your type:
data Direction = N | S | E | W deriving (Eq, Show)
data Movement = Movement Direction Int deriving (Eq, Show)
step :: Movement -> (Int, Int) -> (Int, Int)
step (Movement x h) (y,z)
| x == N = (y, z+h)
| x == S = (y, z-h)
| x == W = (y-h, z)
| x == E = (y+h, z)
Now your code works, since Movement is also a data constructor, and N and friends are no longer functions. I would still prefer to avoid guards, though, and use
step :: Movement -> (Int, Int) -> (Int, Int)
step (Movement N h) (y,z) = (y, z+h)
step (Movement S h) (y,z) = (y, z-h)
step (Movement W h) (y,z) = (y-h, z)
step (Movement E h) (y,z) = (y+h, z)
Related
I'm doing some dynamic programming in Haskell with mutual recursion implementation.
I decided to speed things up using memoization.
Monad.Memo offers MemoT transformer for that exact case. But it uses Map as internal representation for stored values. And while this gave me order of magnitude speed boost it is still not enough.
While lib supports Array-based and Vector-based implementation as internal storage it only works for simple recursion and I did not found any transformers like MemoT to use it for mutual recursion.
What is the best way to do mutual recursion memoization with efficient vector based internal representation (if any)?
My next question is about memoization effect. So I expected my function to take more time during first run and much less during consecutive runs. But what I found running it in ghci the time it takes each time is the same. So no difference between first and second run. I measured time as follows:
timeit $ print $ dynamic (5,5)
With dynamic being my function.
The full implementation is as follows:
import Control.Monad.Memo
import Control.Monad.Identity
type Pos = (Int, Int)
type MemoQ = MemoT (Int, Int, Int) [Int]
type MemoV = MemoT (Int, Int, Int) Int
type MemoQV = MemoQ (MemoV Identity)
-- we are moving to (0,0) as we can always shift the world by substituting variables
-- due to symmetry of cost function it is enougth to solve for only positive x and y
dynamic :: Pos -> [Int]
dynamic (x, y) = lastUnique $ map (evalQ x y) [1 ..]
where lastUnique (x0:x1:xs) | x0 == x1 = x0
| otherwise = lastUnique (x1:xs)
evalQ :: Int -> Int -> Int -> [Int]
evalQ x y n = startEvalMemo . startEvalMemoT $ fqmon x y n
fqmon :: Int -> Int -> Int -> MemoQV [Int]
fqmon _ _ 0 = return [0,0,0,0]
fqmon x y n = do
let pts = neighbours (x, y)
let v = for3 memol1 fvmon n
let c = cost (x, y)
let q = fmap (c +) . uncurry v
traverse q pts
fvmon :: Int -> Int -> Int -> MemoQV Int
fvmon _ 0 0 = return 0
fvmon 0 x y = return $ cost (x, y)
fvmon n x y | limit = return 1000000
| otherwise = liftM minimum $ for3 memol0 fqmon x' y' (n - 1)
where x' = abs x
y' = abs y
limit = x' > 25 || y' > 25
cost :: Pos -> Int
cost (x, y) = abs x + abs y
neighbours :: Pos -> [Pos]
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
Added:
According to #liqui comment I tried memcombinators.
So first is the non memoized initial implementation:
type Pos = (Int, Int)
dynamic :: Int -> Int -> [Int]
dynamic x y = lastUnique $ map (fq x y) [1 ..]
where lastUnique (x0:x1:xs) | x0 == x1 = x0
| otherwise = lastUnique (x1:xs)
fq :: Int -> Int -> Int -> [Int]
fq _ _ 0 = [0, 0, 0, 0] -- Q at 0 step is 0 in all directions
fq x y n = (cost (x, y) +) . (uncurry $ fv n) <$> neighbours (x, y)
fv :: Int -> Int -> Int -> Int
fv _ 0 0 = 0 -- V at (0, 0) is 0 at any atep
fv 0 x y = cost (x, y) -- V at 0 step is a cost
fv n x y = minimum $ fq x y (n - 1)
cost :: Pos -> Int
cost (x, y) = abs x + abs y
neighbours :: Pos -> [Pos]
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
Then my attempt to memization (only changed part):
dynamic :: Int -> Int -> [Int]
dynamic x y = lastUnique $ map (fqmem x y) [1 ..]
where lastUnique (x0:x1:xs) | x0 == x1 = x0
| otherwise = lastUnique (x1:xs)
-- memoizing version of fq
fqmem :: Int -> Int -> Int -> [Int]
fqmem x y n = fqmem' x y n
where fqmem' = memo3 integral integral integral fq
-- memoizing version of fv
fvmem :: Int -> Int -> Int -> Int
fvmem n x y = fvmem' n x y
where fvmem' = memo3 integral integral integral fv
fq :: Int -> Int -> Int -> [Int]
fq _ _ 0 = [0, 0, 0, 0] -- Q at 0 step is 0 in all directions
fq x y n = (cost (x, y) +) . (uncurry $ fvmem n) <$> neighbours (x, y)
fv :: Int -> Int -> Int -> Int
fv _ 0 0 = 0 -- V at (0, 0) is 0 at any atep
fv 0 x y = cost (x, y) -- V at 0 step is a cost
fv n x y = minimum $ fqmem x y (n - 1)
The result a bit of paradox. It is 3 time slower than non memoized recursive implementation. Memoizing only one function (namely fq) and not touching fv gives results 2 times slower. The more I memoize with memcombinators the slower the computation. And again no difference between first and second invocation.
Also the last question. What is the rationale for choosing between Monad.Memo or memcombinators or MemotTrie? There is a point on using last 2 in comments. What are the situations when Monad.Memo is a better choice?
Finally MemoTrie did the job.
At first invocation it works as fast (possibly much faster) than Monad.Memo and at consecutive invocations it take virtually no time!
And tha change in code is trivial compared to monadic approach:
import Data.MemoTrie
type Pos = (Int, Int)
-- we are moving to (0,0) as we can always shift the world by substituting variables
-- due to symmetry it is enougth to solve for only positive x and y
dynamic :: Int -> Int -> [Int]
dynamic x y = lastUnique $ map (fqmem x y) [1 ..]
where lastUnique (x0:x1:xs) | x0 == x1 = x0
| otherwise = lastUnique (x1:xs)
fqmem = memo3 fq
fvmem = memo3 fv
fq :: Int -> Int -> Int -> [Int]
fq _ _ 0 = [0, 0, 0, 0] -- Q at 0 step is 0 in all directions
fq x y n = (cost (x, y) +) . (uncurry $ fvmem n) <$> neighbours (x, y)
fv :: Int -> Int -> Int -> Int
fv _ 0 0 = 0 -- V at (0, 0) is 0 at any atep
fv 0 x y = cost (x, y) -- V at 0 step is a cost
fv n x y = minimum $ fqmem x y (n - 1)
cost :: Pos -> Int
cost (x, y) = abs x + abs y
neighbours :: Pos -> [Pos]
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
Still I would like to know what is the benefits of using Monad.Memo and what are use cases for that? Or it becomes obsolete with MemoTrie?
Why Memocombinators did not worked for me?
What is the rule of thumb on choosing between Monad.Memo, Memocombinators or MemoTrie?
I am trying to define a function that accepts a point (x,y) as input, and returns an infinite list corresponding to recursively calling
P = (u^2 − v^2 + x, 2uv + y)
The initial values of u and v are both 0.
The first call would be
P = (0^2 - 0^2 + 1, 2(0)(0) + 2) = (1,2)
Then that resulting tuple (1,2) would be the next values for u and v, so then it would be
P = (1^2 - 2^2 + 1, 2(1)(2) + 2) = (-2,6)
and so on.
I'm trying to figure out how to code this in Haskell. This is what I have so far:
o :: Num a =>(a,a) -> [(a,a)]
o (x,y) = [(a,b)| (a,b)<- [p(x,y)(x,y)]]
where p(x,y)(u,v) = ((u^2)-(v^2)+x,(2*u*v)+y)
I'm really not sure how to make this work. Any help would be appreciated!
Let's first ignore the exact question you have, and focus on getting the loop working. What you want, essentially, is to have something that takes some initial value iv (namely, (0, 0) for (u, v)), and returns the list
f iv : f (f iv) : f (f (f iv)) : f (f (f (f iv))) : ...
for some function f (constructed from your p and (x, y)). Moreover, you want the result to reuse the previously computed elements of the list. If I would write a function myself that does this, it might looke like this (but maybe with some different names):
looper :: (a -> a) -> a -> [a]
looper f iv = one_result : more_results
where
one_result = f iv
more_results = looper f one_result
But, of course, I would first look if a function with that type exists. It does: it's called Data.List.iterate. The only thing it does wrong is the first element of the list will be iv, but that can be easily fixed by using tail (which is fine here: as long as your iteration function terminates, iterate will always generate an infinite list).
Let's now get back to your case. We established that it'll generally look like this:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = undefined
iv = undefined
As you indicated, the initial value of (u, v) is (0, 0), so that's what our definition of iv will be. f now has to call p with the (x, y) from o's argument and the (u, v) for that iteration:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = p (x, y) (u, v)
iv = (0, 0)
p = undefined
It's as simple as that: the (x, y) from o's definition is actually in scope in the where-clause. You could even decide to merge f and p, and end up with
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate p iv)
where
iv = (0, 0)
p (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
Also, may I suggest that you use Data.Complex for your application? This makes the constraints on a a bit stricter (you need RealFloat a, because of Num.signum), but in my opinion, it makes your code much easier to read:
import Data.Complex
import Data.List (iterate)
{- ... -}
o :: Num (Complex a) => Complex a -> [Complex a]
o c = tail (iterate p iv)
where
iv = 0 -- or "0 :+ 0", if you want to be explicit
p z = z^2 + c
You want:
To construct a list [(u, v)] with the head of this list equal (0, 0)
And then map this list with the function \(u, v) -> (u^2 - v^2 + x, 2 * u * v + y), appending results of this function to the list.
We can write this function as described:
func :: (Num t) => (t, t) -> [(t, t)]
func (x, y) = (0, 0) : map functionP (func (x, y))
where functionP (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
GHCi > take 5 $ func (1, 2)
> [(0,0),(1,2),(-2,6),(-31,-22),(478,1366)]
With gcd its fairly easy but i do not understand how to tie in all the functions to make it happen without.
kgv :: Int -> Int -> Int
kgv x y = abs ((x `quot` (gcd x y)) * y)
I got this function to find the prime factors which works (prime_factors) and I am working on making a function that takes the maximum number from one list and checks if its on the other list (comp):
prime_factors :: Int -> [Int]
prime_factors 1 = []
prime_factors n
| factors == [] = [n]
| otherwise = factors ++ prime_factors (n `div` (head factors))
where factors = take 1 $ filter (\x -> (n `mod` x) == 0) [2 .. n-1]
comp :: [Int]->Int
comp (ys)(x:xs)
|maximum prime_factors xs elem prime_factors ys == x
|otherwise tail x
kgv :: Int -> Int -> Int
kgv x y = abs ((x `quot` (comp x y)) * y)
Here's an absurdly simple and obscenely inefficient solution:
lcm m n = head [x | x <- [1..], x `rem` m == 0, x `rem` n == 0]
Of course, this relies on two different notions of "least" coinciding under the circumstances, which they do. A fully naive solution doesn't seem possible.
here is the (very) naive algorithm I was talking about:
kgv :: (Ord a, Num a) => a -> a -> a
kgv x y = find x y
where find i j
| i == j = i
| i < j = find (i+x) j
| i > j = find i (j+y)
it's basically what a school-child would do ;)
caution I ignored negative numbers and 0 - you'll probably have to handle those
perhaps another easy way is
import Data.List(intersect)
lcm m n = head $ intersect (series m n) (series n m)
where series a b = take a $ map (*b) [1..]
I figured it out myself mostly. Thanks for the ideas and pointers.
ggt n m | n > m = maximum [t | t <- [1 .. m], gt n m t]
| otherwise = maximum [t | t <- [1 .. n], gt n m t]
gt n m c = t n c && t m c
t n c | n >= c = (mod n c == 0)
| otherwise = False
kgv :: Int -> Int -> Int
kgv x y |x==0=0|y==0=0 |otherwise = abs ((x `quot` (ggt x y)) * y)
Learning Haskell and I am not sure why I don't get the expected result, given these definitions:
instance Ring Integer where
addId = 0
addInv = negate
mulId = 1
add = (+)
mul = (*)
class Ring a where
addId :: a -- additive identity
addInv :: a -> a -- additive inverse
mulId :: a -- multiplicative identity
add :: a -> a -> a -- addition
mul :: a -> a -> a -- multiplication
I wrote this function
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit mulId) <- x = y
| (Lit mulId) <- y = x
squashMul x y = Mul x y
However:
*HW05> squashMul (Lit 5) (Lit 1)
Lit 1
If I write one version specifically for Integer:
squashMulInt :: RingExpr Integer -> RingExpr Integer -> RingExpr Integer
squashMulInt x y
| (Lit 1) <- x = y
| (Lit 1) <- y = x
squashMulInt x y = Mul x y
Then I get the expected result.
Why does (Lit mulId) <- x match even when x is not (Lit 1) ?
Variables used in pattern matching are considered to be local variables. Consider this definition for computing the length of a list:
len (x:xs) = 1 + len xs
len _ = 0
Variables x and xs are local variables to this definition. In particular, if we add a definition for a top-level variable, as in
x = 10
len (x:xs) = 1 + len xs
len _ = 0
this does not affect the meaning for len. More in detail, the first pattern (x:xs) is not equivalent to (10:xs). If it were interpreted in that way, we would now have len [5,6] == 0, breaking the previous code! Fortunately, the semantics of pattern matching is robust to such new declarations as x=10.
Your code
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit mulId) <- x = y
| (Lit mulId) <- y = x
squashMul x y = Mul x y
actually means
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit w) <- x = y
| (Lit w) <- y = x
squashMul x y = Mul x y
which is wrong, since w can be arbitrary. What you want is probably:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit w) <- x , w == mulId = y
| (Lit w) <- y , w == mulId = x
squashMul x y = Mul x y
(The Eq a constraint may depend on the definition of RingExpr, which was not posted)
You can also simplify everything to:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x#(Lit w) y | w == mulId = y
squashMul x y#(Lit w) | w == mulId = x
squashMul x y = Mul x y
or even to:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul (Lit w) y | w == mulId = y
squashMul x (Lit w) | w == mulId = x
squashMul x y = Mul x y
This version does not even use pattern guards, since there's no need to.
I'm trying to memoize the following function:
gridwalk x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Looking at this I came up with the following solution:
gw :: (Int -> Int -> Int) -> Int -> Int -> Int
gw f x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (f (x - 1) y) + (f x (y - 1))
gwlist :: [Int]
gwlist = map (\i -> gw fastgw (i `mod` 20) (i `div` 20)) [0..]
fastgw :: Int -> Int -> Int
fastgw x y = gwlist !! (x + y * 20)
Which I then can call like this:
gw fastgw 20 20
Is there an easier, more concise and general way (notice how I had to hardcode the max grid dimensions in the gwlist function in order to convert from 2D to 1D space so I can access the memoizing list) to memoize functions with multiple parameters in Haskell?
You can use a list of lists to memoize the function result for both parameters:
memo :: (Int -> Int -> a) -> [[a]]
memo f = map (\x -> map (f x) [0..]) [0..]
gw :: Int -> Int -> Int
gw 0 _ = 1
gw _ 0 = 1
gw x y = (fastgw (x - 1) y) + (fastgw x (y - 1))
gwstore :: [[Int]]
gwstore = memo gw
fastgw :: Int -> Int -> Int
fastgw x y = gwstore !! x !! y
Use the data-memocombinators package from hackage. It provides easy to use memorization techniques and provides an easy and breve way to use them:
import Data.MemoCombinators (memo2,integral)
gridwalk = memo2 integral integral gridwalk' where
gridwalk' x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Here is a version using Data.MemoTrie from the MemoTrie package to memoize the function:
import Data.MemoTrie(memo2)
gridwalk :: Int -> Int -> Int
gridwalk = memo2 gw
where
gw 0 _ = 1
gw _ 0 = 1
gw x y = gridwalk (x - 1) y + gridwalk x (y - 1)
If you want maximum generality, you can memoize a memoizing function.
memo :: (Num a, Enum a) => (a -> b) -> [b]
memo f = map f (enumFrom 0)
gwvals = fmap memo (memo gw)
fastgw :: Int -> Int -> Int
fastgw x y = gwvals !! x !! y
This technique will work with functions that have any number of arguments.
Edit: thanks to Philip K. for pointing out a bug in the original code. Originally memo had a "Bounded" constraint instead of "Num" and began the enumeration at minBound, which would only be valid for natural numbers.
Lists aren't a good data structure for memoizing, though, because they have linear lookup complexity. You might be better off with a Map or IntMap. Or look on Hackage.
Note that this particular code does rely on laziness, so if you wanted to switch to using a Map you would need to take a bounded amount of elements from the list, as in:
gwByMap :: Int -> Int -> Int -> Int -> Int
gwByMap maxX maxY x y = fromMaybe (gw x y) $ M.lookup (x,y) memomap
where
memomap = M.fromList $ concat [[((x',y'),z) | (y',z) <- zip [0..maxY] ys]
| (x',ys) <- zip [0..maxX] gwvals]
fastgw2 :: Int -> Int -> Int
fastgw2 = gwByMap 20 20
I think ghc may be stupid about sharing in this case, you may need to lift out the x and y parameters, like this:
gwByMap maxX maxY = \x y -> fromMaybe (gw x y) $ M.lookup (x,y) memomap