type Parser a = String -> Maybe (a, String)
parseChar :: Char -> Parser Char
parseChar _ "" = Nothing
parseChar ch (x:xs) | x == ch = Just (ch, xs)
| otherwise = Nothing
parseAnyChar :: String -> Parser Char
parseAnyChar "" _ = Nothing
parseAnyChar _ "" = Nothing
parseAnyChar (x:xs) str | isJust res = res
| otherwise = parseAnyChar xs str
where res = parseChar x str
I'm a beginner in haskell and I would like to know how can I use parseChar in parseAnyChar in a more "haskell way" than looping recursively. Using a map for example or anything else but I can't find.
Yes. For one thing, you can just use a standard function instead of manual recursion, to try parseChar on all the specified alternatives:
import Data.List (find)
parseAnyChar cs str = case find isJust ress of
Just res -> res
Nothing -> Nothing
where ress = [parseChar c str | c<-cs]
...or shorter
import Data.Maybe (listToMaybe)
import Control.Monad (join)
parseAnyChar cs str = join . listToMaybe $ (`parseChar`str)<$>cs
A more efficient solution is to not attempt all the options in the first place, but instead use a Set of options:
import qualified Data.Set as Set
parseOneCharOf :: Set.Set Char -> Parser Char
parseOneCharOf _ "" = Nothing
parseOneCharOf cs (x:xs)
| x`Set.member`cs = Just x
| otherwise = Nothing
...or shorter
import Control.Monad (guard)
parseOneCharOf cs (x:xs) = guard (x`Set.member`cs) >> Just x
You can make use of Alternative instance of Maybe:
import Control.Applicative((<|>))
parseAnyChar :: Foldable f => f Char -> Parser Char
parseAnyChar xs str = foldr ((<|>) . (`parseChar` str)) Nothing xs
This works since, (<|>) for Maybe is implemented as [src]:
instance Alternative Maybe where
empty = Nothing
Nothing <|> r = r
l <|> _ = l
So in case the left operand is Nothing, we pick the right one, if the left one is a Just …, we pick the first one.
We thus can rewrite the parseAnyChar to:
parseAnyChar :: String -> Parser Char
parseAnyChar "" _ = Nothing
parseAnyChar _ "" = Nothing
parseAnyChar (x:xs) str = parseChar x str <|> parseAnyChar xs str
We do not need a special case for the second parameter being "" however, since this is already covered by the logic in parseChar. We thus can drop the second clause:
parseAnyChar :: String -> Parser Char
parseAnyChar [] _ = Nothing
parseAnyChar (x:xs) str = parseChar x str <|> parseAnyChar xs str
and now we can rewrite this to a foldr pattern.
This also makes it possible to use an Foldable as source of characters.
If the number of items is however large, you might want to use a more efficient data structure, like #leftroundabout suggests.
Related
I've tried a bunch of stuff, and they always seem to result in one of 2 things:
Program hangs forever (infinite left recursion)
Right associativity (right recursion)
My only idea now is just to parse from the end of the string instead of the beginning, but do to the list nature of haskell's strings, that would require either traversing the list for every charachter, or parsing a reversed string. Neither option sound good.
Here's the relevant bits from my current code (which is right associative). I've tried left recursion, but it just ends up in an infinite loop.
{-# LANGUAGE PatternGuards #-}
data C = S | K | I deriving (Read,Show,Eq)
data T = N T T | C C deriving Eq
parse :: String -> T
parse s | (e,rest) <- parseStep s = if rest == "" then e else N e (parse rest)
parseStep :: String -> (T,String)
parseStep ('(':s) = parseParen s
parseStep (c:s) = (C $ read [c],s)
parseParen (c:')':s) = (C $ read [c],s)
parseParen s = parseStep s
Figured it out thanks to luqui's comment:
parse :: String -> T
parse = foldTs . parseList
foldTs :: [T] -> T
foldTs (t:ts) = foldl N t ts
parseList :: String -> [T]
parseList "" = []
parseList s = let (x,r) = parseStep s in x:parseList r
parseStep :: String -> (T,String)
parseStep ('(':s) = let (ts,r) = parseParenList s in (foldTs ts,r)
parseStep (c:s) = (C $ read [c],s)
parseParenList :: String -> ([T],String)
parseParenList (')':s) = ([],s)
parseParenList s =
let
(x,r) = parseStep s
(xs,r') = parseParenList r
in (x:xs,r')
i m not familiar with askell.
i have to do this function parseChar :: Char -> Parser Char
> parseChar 'a' " abcd "
Just ('a', "bcd")
> parseChar 'z' " abcd "
Nothing
i did this function
type Parser r = String -> Maybe (Char, String)
parseChar :: Char -> Parser Char
parseChar x = \xs -> Just(x, xs)
i dont really understand the \ and how can I take all the string except the second.
Thanks!!
i dont really understand the \ and how can I take all the string except the second.
The \ is a lambda expression \xs -> … is a function that maps a variable xs to the … part. Here you can however move the variable to the head of the clause.
You however need to check if the first element of the string is indeed the element you are parsing:
parseChar :: Char -> Parser Char
parseChar _ "" = Nothing
parseChar x (y:ys)
| x == y = Just (y, ys)
| otherwise = Nothing
Here x is thus the char we want to parse, and "" or (y:ys) the string that we are parsing. "" means that the string is empty, in which case we return Nothing. If the string is not empty, we unpack it in the first character (head) y, and the list of remaining characters (tail) ys. In case x == y, we are thus parsing the correct character, and we can return a 2-tuple wrapped in a Just constructor. In case x is not equal to y, the parser should "fail" and return Nothing.
This then yields:
Prelude> parseChar 'a' "abcd"
Just ('a',"bcd")
Prelude> parseChar 'z' "abcd"
Nothing
Prelude> parseChar 'a' ""
Nothing
So the problem I'm working on matching a pattern to a list, such like this:
match "abba" "redbluebluered" -> True or
match "abba" "redblueblue" -> False, etc. I wrote up an algorithm that works, and I think it's reasonable understandable, but I'm not sure if there's a better way to do this without explicit recursion.
import Data.HashMap.Strict as M
match :: (Eq a, Eq k, Hashable k) => [k] -> [a] -> HashMap k [a] -> Bool
match [] [] _ = True
match [] _ _ = False
match _ [] _ = False
match (p:ps) s m =
case M.lookup p m of
Just v ->
case stripPrefix v s of
Just post -> match ps post m
Nothing -> False
Nothing -> any f . tail . splits $ s
where f (pre, post) = match ps post $ M.insert p pre m
splits xs = zip (inits xs) (tails xs)
I would call this like match "abba" "redbluebluered" empty. The actual algorithm is simple. The map contains the patterns already matched. At the end it is [a - > "red", b -> "blue"]. If the next pattern is one we've seen before, just try matching it and recurse down if we can. Otherwise fail and return false.
If the next pattern is new, just try mapping the new pattern to every single prefix in the string and recursing down.
This is very similar to a parsing problem, so let's take a hint from the parser monad:
match should return a list of all of the possible continuations of the parse
if matching fails it should return the empty list
the current set of assignments will be state that has to carried through the computation
To see where we are headed, let's suppose we have this magic monad. Attempting to match "abba" against a string will look like:
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
return () -- or whatever you want to return
test = runMatch matchAbba "redbluebluered"
It turns out this monad is the State monad over the List monad. The List monad provides for backtracking and the State monad carries the current assignments and input around.
Here's the code:
import Data.List
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Data.Maybe
import qualified Data.Map as M
import Data.Monoid
type Assigns = M.Map Char String
splits xs = tail $ zip (inits xs) (tails xs)
var p = do
(assigns,input) <- get
guard $ (not . null) input
case M.lookup p assigns of
Nothing -> do (a,b) <- lift $ splits input
let assigns' = M.insert p a assigns
put (assigns', b)
return a
Just t -> do guard $ isPrefixOf t input
let inp' = drop (length t) input
put (assigns, inp')
return t
matchAbba :: StateT (Assigns, String) [] Assigns
matchAbba = do
var 'a'
var 'b'
var 'b'
var 'a'
(assigns,_) <- get
return assigns
test1 = evalStateT matchAbba (M.empty, "xyyx")
test2 = evalStateT matchAbba (M.empty, "xyy")
test3 = evalStateT matchAbba (M.empty, "redbluebluered")
matches :: String -> String -> [Assigns]
matches pattern input = evalStateT monad (M.empty,input)
where monad :: StateT (Assigns, String) [] Assigns
monad = do sequence $ map var pattern
(assigns,_) <- get
return assigns
Try, for instance:
matches "ab" "xyz"
-- [fromList [('a',"x"),('b',"y")],fromList [('a',"x"),('b',"yz")],fromList [('a',"xy"),('b',"z")]]
Another thing to point out is that code which transforms a string like "abba" to the monadic value do var'a'; var'b'; var 'b'; var 'a' is simply:
sequence $ map var "abba"
Update: As #Sassa NF points out, to match the end of input you'll want to define:
matchEnd :: StateT (Assigns,String) [] ()
matchEnd = do
(assigns,input) <- get
guard $ null input
and then insert it into the monad:
monad = do sequence $ map var pattern
matchEnd
(assigns,_) <- get
return assigns
I would like to modify your signature and return more than Bool. Your solution then becomes:
match :: (Eq a, Ord k) => [k] -> [a] -> Maybe (M.Map k [a])
match = m M.empty where
m kvs (k:ks) vs#(v:_) = let splits xs = zip (inits xs) (tails xs)
f (pre, post) t =
case m (M.insert k pre kvs) ks post of
Nothing -> t
x -> x
in case M.lookup k kvs of
Nothing -> foldr f Nothing . tail . splits $ vs
Just p -> stripPrefix p vs >>= m kvs ks
m kvs [] [] = Just kvs
m _ _ _ = Nothing
Using the known trick of folding to produce a function we can obtain:
match ks vs = foldr f end ks M.empty vs where
end m [] = Just m
end _ _ = Nothing
splits xs = zip (inits xs) (tails xs)
f k g kvs vs = let h (pre, post) = (g (M.insert k pre kvs) post <|>)
in case M.lookup k kvs of
Nothing -> foldr h Nothing $ tail $ splits vs
Just p -> stripPrefix p vs >>= g kvs
Here match is the function folding all keys to produce a function taking a Map and a string of a, which returns a Map of matches of the keys to substrings. The condition for matching the string of a in its entirety is tracked by the last function applied by foldr - end. If end is supplied with a map and an empty string of a, then the match is successful.
The list of keys is folded using function f, which is given four arguments: the current key, the function g matching the remainder of the list of keys (i.e. either f folded, or end), the map of keys already matched, and the remainder of the string of a. If the key is already found in the map, then just strip the prefix and feed the map and the remainder to g. Otherwise, try to feed the modified map and remainder of as for different split combinations. The combinations are tried lazily as long as g produces Nothing in h.
Here is another solution, more readable, I think, and as inefficient as other solutions:
import Data.Either
import Data.List
import Data.Maybe
import Data.Functor
splits xs = zip (inits xs) (tails xs)
subst :: Char -> String -> Either Char String -> Either Char String
subst p xs (Left q) | p == q = Right xs
subst p xs q = q
match' :: [Either Char String] -> String -> Bool
match' [] [] = True
match' (Left p : ps) xs = or [ match' (map (subst p ixs) ps) txs
| (ixs, txs) <- tail $ splits xs]
match' (Right s : ps) xs = fromMaybe False $ match' ps <$> stripPrefix s xs
match' _ _ = False
match = match' . map Left
main = mapM_ (print . uncurry match)
[ ("abba" , "redbluebluered" ) -- True
, ("abba" , "redblueblue" ) -- False
, ("abb" , "redblueblue" ) -- True
, ("aab" , "redblueblue" ) -- False
, ("cbccadbd", "greenredgreengreenwhiteblueredblue") -- True
]
The idea is simple: instead of having a Map, store both patterns and matched substrings in a list. So when we encounter a pattern (Left p), then we substitute all occurrences of this pattern with a substring and call match' recursively with this substring being striped, and repeat this for each substring, that belongs to inits of a processed string. If we encounter already matched substring (Right s), then we just try to strip this substring, and call match' recursively on a successive attempt or return False otherwise.
I wanted to write a Haskell function that takes a string, and replaces any space characters with the special code %20. For example:
sanitize "http://cs.edu/my homepage/I love spaces.html"
-- "http://cs.edu/my%20homepage/I%20love%20spaces.html"
I am thinking to use the concat function, so I can concatenates a list of lists into a plain list.
The higher-order function you are looking for is
concatMap :: (a -> [b]) -> [a] -> [b]
In your case, choosing a ~ Char, b ~ Char (and observing that String is just a type synonym for [Char]), we get
concatMap :: (Char -> String) -> String -> String
So once you write a function
escape :: Char -> String
escape ' ' = "%20"
escape c = [c]
you can lift that to work over strings by just writing
sanitize :: String -> String
sanitize = concatMap escape
Using a comprehension also works, as follows,
changer :: [Char] -> [Char]
changer xs = [ c | v <- xs , c <- if (v == ' ') then "%20" else [v] ]
changer :: [Char] -> [Char] -> [Char]
changer [] res = res
changer (x:xs) res = changer xs (res ++ (if x == ' ' then "%20" else [x]))
sanitize :: [Char] -> [Char]
sanitize xs = changer xs ""
main = print $ sanitize "http://cs.edu/my homepage/I love spaces.html"
-- "http://cs.edu/my%20homepage/I%20love%20spaces.html"
The purpose of sanitize function is to just invoke changer, which does the actual work. Now, changer recursively calls itself, till the current string is exhausted.
changer xs (res ++ (if x == ' ' then "%20" else [x]))
It takes the first character x and checks if it is equal to " ", if so gives %20, otherwise the actual character itself as a string, which we then concatenate with the accumulated string.
Note: This is may not be the optimal solution.
You can use intercalate function from Data.List module. It does an intersperse with given separator and list, then concats the result.
sanitize = intercalate "%20" . words
or using pattern matching :
sanitize [] = []
sanitize (x:xs) = go x xs
where go ' ' [] = "%20"
go y [] = [y]
go ' ' (x:xs) = '%':'2':'0': go x xs
go y (x:xs) = y: go x xs
Another expression of Shanth's pattern-matching approach:
sanitize = foldr go []
where
go ' ' r = '%':'2':'0':r
go c r = c:r
I want format this function:
getEnv :: [Func] -> ([Char] -> RetType)
getEnv [] = (\_ -> undefined)
getEnv ((Func (RetTypeType t) (Ident fname) _ _):fs) = (\x -> if x == fname then t else getEnv fs)
The problem is caused by a long pattern matching, and for now I don't want to change the names of constructors. Also the right part of the function at the third line is not easy to formatting for me.
Although is not matter of life or death, I'm curios how you format this code. Thanks.
Basically, you have two possibilities:
Something like this:
getEnv ((Func
(RetTypeType t)
(Ident fname) _ _)
:fs)
= (\x -> if x == fname then t else getEnv fs)
or you can use pattern guards:
getEnv (h:fs)
| Func a b _ _ <- h,
Rectype t <- a,
Ident fname <- b
= (\x -> if x == fname then t else getEnv fs)
You could furthermore avoid the lambda:
getEnv (h:fs) x
| Func a b _ _ <- h,
Rectype t <- a,
Ident fname <- b
= if x == fname then t else getEnv fs
The downside with "open" pattern guards may be that the compiler cannot decide anymore whether your patterns are exhaustive.
As #leftaroundabout points out, we can put it even more clearly thus:
getEnv (h:fs) x
| Func a b _ _ <- h,
Rectype t <- a,
Ident fname <- b,
x == fname = t
| otherwise = getEnv fs
This will also let the compiler know that all possible forms of the head of the list are covered, so this I'd term the most preferred way to do it.
I would usually simply do
getEnv :: [Func] -> ([Char] -> RetType)
getEnv [] = (\_ -> undefined)
getEnv ((Func (RetTypeType t) (Ident fname) _ _):fs)
= \x -> if x == fname then t else getEnv fs
However I'd be inclined if I was doing a lot of that to use record syntax
data Func = Func {returnTypeType :: RetTypeType,
identifier :: Ident,
.... }
data RetTypeType = RetTypeType {unRetTypeType :: RetType}
data Ident = Ident {unIdent:: String}
so I could write
getEnv :: [Func] -> ([Char] -> RetType)
getEnv [] = (\_ -> undefined)
getEnv (f:fs) = \x -> if x == ident f
then unRetTypeType.returnTypeType $ f
else getEnv fs
First of all, I try to keep patterns simple. Usually it's just one constructor with variables or underscores as it's arguments. Exception: built-in constructors like (:) or (,) don't count. So, if you have that kind of pattern-matching, I think you are doing something wrong.
Secondly, I would just split the line at '=' and be happy.