I want to write a function that takes two Maybe Int parameters and returns the minimum of them if they are both Just number, and 'the other' if either of them is Nothing. I'm not satisfied with my first attempt:
maybeMin :: Maybe Int -> Maybe Int -> Maybe Int
maybeMin Nothing arr = arr
maybeMin ell Nothing = ell
maybeMin ell#(Just l) arr#(Just r) = if l < r then ell else arr
As an optimisation I don't want to create a new value in the third case; i.e., I don't want to write
maybeMin ell#(Just l) arr#(Just r) = Just $ if l < r then l else r
The above code seems clunky and it seems to me that I ought to be able to exploit the fact that Maybe is an instance of Functor, Applicative or Monad. However, my best attempt to go higher-order doesn't do the same thing:
maybeMin ell arr = ell >>= (\l -> arr >>= (\r -> if l < r then ell else arr))
because it will return Nothing if either operand be Nothing.
Is there an elegant way to do what I want?
You looked at Functor, Applicative, and Monad, but you may want to check out Alternative. As an example of its use, Just 3 <|> Nothing will yield Just 3 and not Nothing.
For your particular use, if you want a one-liner, you could try:
maybeMin l r = min l r <|> l <|> r
Just to break that down, we first calculate min l r, which uses the Ord instance of Maybe to give the minimum of l and r if both are Just values. If this works, then the computation stops there, but if either one isn't Just, then we check to see if l is a Just value. If it is, then that is the result, and if not, we end up returning r as the result.
Related
Compiler warns the function "insert" is non-exhaustive in the following code:
data Set a = Empty | Set a (Set a) (Set a) deriving (Eq, Show)
insert :: (Ord a) => a -> Set a -> Set a
insert x Empty = Set x Empty Empty
insert x (Set v l r)
| x <= v = Set v (insert x l) r
| v < x = Set v l (insert x r)
-- | otherwise = Set x Empty Empty
main :: IO ()
main = do
let x = insert (5::Int) Empty
print x
GHC reports this
test.hs:4:1: warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In an equation for ‘insert’: Patterns not matched: _ (Set _ _ _)
If I uncomment the last line (it's commented out now) in the function, GHC does not report any warning. So I guess GHC thinks the guards are non-exhaustive. But why? If x and v are instances of Ord, then I guess
(x <= v) and (v < x) are all the possible outcomes of comparison?
What if I define this instance:
newtype Fuzzy = Fuzzy Double
instance Eq Fuzzy where
Fuzzy a == Fuzzy b = abs (a-b) < 0.1
instance Ord Fuzzy where
Fuzzy a < Fuzzy b = a < b-0.1
Fuzzy a <= Fuzzy b = a <= b
Then for e.g. v = Fuzzy 0, x = Fuzzy 0.1, you have (x <= v) = (0.1 <= 0) which is false, but (v < x) = (0 < 0) which is also false. Hence both of your guards will fail.
This isn't so hypothetical, in fact Double itself already has such behaviour in degenerate values:
Prelude> sqrt (-1) < 0
False
Prelude> 0 <= sqrt (-1)
False
Now, it's very debatable whether these are really good, even well-formed Ord instances, but at any rate the compiler can't guarantee something like that won't happen. Hence it also can't make the assumption that not (x <= v) implies v < x, so what should happen if neither is fulfilled?
The usual thing to do if you assume all Ord instances you received are docile is to just make the second clause already catch-all:
insert x (Set v l r)
| x <= v = Set v (insert x l) r
| otherwise = Set v l (insert x r)
However, depending on your philosophy, your original code might actually be better. With the catch-all in the second, you just defer the weirdness if someone hands you NaN values. This makes it all the more difficult to understand what's going on.
If tend to deliberately not complete patterns with “impossible cases” in experimental code: this way I'll at least always get a clear runtime error telling me at which point in the code things go awry. Once the code essentially works and you want to make it production-ready, you can then toss in -Wall and learn about all spots where you'd better add some explicit handling of pathological behaviour like the one I mentioned.
I am trying to implement the Bron-Kerbosch algorithm for finding the number of maximum cliques (maximum Clique is a subset of a graph where every two verticies are connected and there is no larger clique containing it)
https://en.wikipedia.org/wiki/Bron%E2%80%93Kerbosch_algorithm
Unfortunately, I get an error : "parse error on input 'res' "
And I can't seem to solve it. I have tried to change the tap spaces with normal ones, but it doesn't seem to work. I also don't see any errors? Any ideas?
type Clique = [Vertex]
swarming::Clique->[Vertex]->[Vertex]->[Clique]
swarming R P X =
if null P && null X then [R]
else loop R X
where
loop::[Vertex]->[Vertex]->[Clique]
loop[] _ =[]
loop(v:R') X=
swarming (v:R)(P 'res' v)(X 'res' v)
loop P (v:X)
type Vertex = Int
class Graph g where
size ::g->Int
verticies ::g->[Vertex]
connected ::g->Vertex->Vertex->Bool
bron::Graph g=>g->[Clique]
bron g = swarming[] (verticies g) []
where
swarming R P X =
if null P && null X then [R]
else loop R X
where
loop::[Vertex]->[Vertex]->[Clique]
loop[] _ =[]
loop(v:R) X=
swarming (v:R)(P 'res' v)(X 'res' v)
loop P (v:X)
res::[Vertex]->Vertex->[Vertex]
res vs v = filter(connected g v) vs
As I can see there is a bit more wrong with your code than just the error you get:
first of all as the comment already says ' are reserved for single characters Char, the syntax you are looking for is `res`.
secondly I saw you are using tabs, newer versions of the ghc compiler will warn you about that, usually nowadays people use spaces (this is mostly a matter of taste and it is up to you)
I have slightly reordered your code and modified it in such a way it compiles. The undefined will raise a run-time error, but this state is better than a non-compiling one.
type Clique = [Vertex]
type Vertex = Int
class Graph g where
size :: g -> Int
vertices :: g -> [Vertex]
connected :: g -> Vertex -> Vertex -> Bool
I usually organize my code in a way that type/data/class declarations are on top of my file and the rest below that.
Syntax wise the next error you have is using upper case letters for variable names - this is not allowed in haskell. Types start with upper case variables with lower case.
bron is a tricky function and I honestly cannot quite figure out what you want to do there are two things that make this hard to figure out.
You have 'variables' r and r in both swarming and loop - it seems that they should be not the same, whereas p should be always the same.
Name shadowing is not a syntactic problem but a logical, it makes it easier if two different things have not the same name.
I see
loop ... = swarming
loop
this is invalid haskell syntax - what are you going to do with swarming it is not used in the following parts of the code, use let … in to stitch those two lines together
here is the rest of your code bron with a compiling but incomplete implementation
bron :: Graph g => g -> [Clique]
bron g = swarming [] (vertices g) []
where res :: [Vertex] -> Vertex -> [Vertex]
res vs v = filter (connected g v) vs
swarming :: Clique -> [Vertex] -> [Vertex] -> [Clique]
swarming r [] [] = [r]
swarming r p x = loop r x
where loop :: [Vertex] -> [Vertex] -> [Clique]
loop [] _ = []
loop (v:r) x = undefined
-- let sw = swarming (v:x) (p `res` v) (x `res` v)
-- in loop ??
I'm trying to understand Haskell monads and wrote this test program, which compiles and works as expected:
divide :: Int -> Int -> Either String Int
divide _ 0 = Left "Divide by zero error
divide numerator denom = Right (numerator `div` denom)
processNumsMonadically :: Int -> Int -> Either String Int
processNumsMonadically n d = divide n d >>= \q -> return (q+1)
When I try using the word bind instead of the >>= operator in the latter function definition:
processNumsMonadically n d = bind (divide n d) (\q -> return (q+1))
I get the error:
Not in scope: 'bind'
What is the correct way to use the word bind?
This isn't a part of Prelude; it resides in Control.Monad.Extra, a part of monad-extras package.
However, you can call operators in prefix manner (like named functions) easily:
processNumsMonadically n d = (>>=) (divide n d) (\q -> return (q+1))
You could also just use do notation:
processNumsMonadically n d = do
q <- divide n d
return (q+1)
But while we're at it, I'd write using a Functor:
processNumsMonadically n d = fmap (+1) (divide n d)
or Applicative syntax:
processNumsMonadically n d = (+1) <$> divide n d
You could also lift the +1 to avoid the need for return and the lambda.
As a personal style remark, bind used as a word isn't idiomatic, and IMHO you shouldn't use it.
At the page http://www.haskell.org/haskellwiki/Pointfree#Tool_support, it talks about the (->) a monad.
What is this monad? The use of symbols makes it hard to google.
This is a Reader monad. You can think of it as
type Reader r = (->) r -- Reader r a == (->) r a == r -> a
instance Monad (Reader r) where
return a = const a
m >>= f = \r -> f (m r) r
And do computations like:
double :: Num r => Reader r r
double = do
v <- id
return (2*v)
It is the function monad, and it's a bit weird to understand. It's also sometimes called the Reader monad, by the way. I think the best way to illustrate how it works is through an example:
f1 :: Double -> Double
f1 x = 10 * x + x ** 2 + 3 * x ** 3
f2 :: Double -> Double
f2 = do
x1 <- (10 *)
x2 <- (** 2)
x3 <- (** 3)
return $ x1 + x2 + 3 * x3
If you try out both of these, you'll see that you get the same output from both. So what exactly is going on? When you "extract" a value from a function, you get what can be considered its "return value". I put quotes around it because when you return a value from this monad, the value you return is a function.
For an example like this, the implicit argument to f2 gets passed to each <- as an implicit argument. It can be fairly useful if you have a lot of sub expressions with the same argument. As the Reader monad, it is generally used to supply read-only config values.
So I'm working on a minimax implementation for a checkers-like game to help myself learn Haskell better. The function I'm having trouble with takes a list for game states, and generates the list of immediate successor game states. Like checkers, if a jump is available, the player must take it. If there's more than one, the player can choose.
For the most part, this works nicely with the list monad: loop over all the input game states, loop over all marbles that could be jumped, loop over all jumps of that marble. This list monad nicely flattens all the lists out into a simple list of states at the end.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list. The code below is the best way I've come up with of doing that, but it seems really ugly to me. Any suggestions on how to clean it up?
eHex :: Coord -> Coord -- Returns the coordinates immediately to the east on the board
nwHex :: Coord -> Coord -- Returns the coordinates immediately to the northwest on the board
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states = do
ws <- states
case children ws of
[] -> return ws
n#_ -> n
where
children ws#(ZertzState s1 s2 b p) = do
(c, color) <- occupiedCoords ws
(start, end) <- [(eHex, wHex), (wHex, eHex), (swHex, neHex),
(neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
if (hexOccupied b $ start c) && (hexOpen b $ end c)
then case p of
1 -> return $ ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
(-1) -> return $ ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
else []
EDIT: Provide example type signatures for the *Hex functions.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list.
Why? I've written minimax several times, and I can't imagine a use for such a function. Wouldn't you be better off with a function of type
nextStates :: [ZertzState] -> [Maybe [ZertzState]]
or
nextStates :: [ZertzState] -> [[ZertzState]]
However if you really want to return "either the list of next states, or if that list is empty, the original state", then the type you want is
nextStates :: [ZertzState] -> [Either ZertzState [ZertzState]]
which you can then flatten easily enough.
As to how to implement, I recommend defining a helper function of type
[ZertzState] -> [(ZertzState, [ZertzState])]
and than you can map
(\(start, succs) -> if null succs then Left start else Right succs)
over the result, plus various other things.
As Fred Brooks said (paraphrasing), once you get the types right, the code practically writes itself.
Don't abuse monads notation for list, it's so heavy for nothing. Moreover you can use list comprehension in the same fashion :
do x <- [1..3]
y <- [2..5] <=> [ x + y | x <- [1..3], y <- [2..5] ]
return x + y
now for the 'simplification'
listOfHex :: [(Coord -> Coord,Coord -> Coord)]
listOfHex = [ (eHex, wHex), (wHex, eHex), (swHex, neHex)
, (neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states =
[if null ws then ws else children ws | ws <- states]
where -- I named it foo because I don t know what it do....
foo True 1 = ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
foo True (-1) = ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
foo False _ = []
foo _ _ = error "Bleh"
children ws#(ZertzState s1 s2 b p) =
[ foo (valid c hex) p | (c, _) <- occupiedCoords ws, hex <- listOfHex ]
where valid c (start, end) =
(hexOccupied b $ start c) && (hexOpen b $ end c)
The let in the let in list commprehension at the top bother me a little, but as I don't have all the code, I don't really know how to do it in an other way. If you can modify more in depth, I suggest you to use more combinators (map, foldr, foldl' etc) as they really reduce code size in my experience.
Note, the code is not tested, and may not compile.