I need a program that receives a String containing an octal number and converts it to decimal. If the String contains anything that's not a number from 0 to 8, the function should return a 0.
This is what I got:
octoDec :: [Char] -> Int
octoDec [] = 0
octoDec (x:xs) = ((digitToInt(x)) * 8 ^(length xs)) + octoDec xs
If I enter octoDec ['1','2','3'] I get 83 , which is expected. However, how can I validate the user's without needing another function?
Edit: I've manage to build a function that checks if a number contains only digits between 0 and 7:
isOcto :: [Char] -> Bool
isOcto [] = True
isOcto (x:xs) | (digitToInt(x) > 0) && digitToInt(x) < 7 = isOcto (xs)
|otherwise = False
what i wanted is to merge these two functions into one and return zero to invalid.
If you want octoDec to not only return the result, but also determine whether a result is even possible, return a Maybe Int instead of Int:
octoDec :: [Char] -> Maybe Int
octoDec [] = Just 0
octoDec (x:xs) = do
rest <- octoDec xs
let d = digitToInt x
guard $ d >= 0 && d <= 7
pure $ rest + d * 8^length xs
The guard function from Control.Monad will make the whole do block return Nothing if the condition doesn't hold.
First, you'll want to use Horner's Method to efficiently convert a sequence of digits to a single value.
> foldl (\acc n -> 8*acc + n) 0 (map digitToInt "123")
83
map digitToInt parses the string, and
foldl (\acc n -> 8*acc + n) 0 is a function that evaluates the result of the parse.
horner :: [Int] -> Int
horner = foldl (\acc n -> 8*acc + n) 0
parseString :: [Char] -> [Int]
parseString = fmap digitToInt
octoDec :: [Char] -> Int
octoDec = horner . parseString
However, digitToInt isn't quite right: it can accept digits greater than 7,
> parseString "193"
[1,9,3]
and raises an exception for a value that isn't a digit at all.
> parseString "foo"
[15,*** Exception: Char.digitToInt: not a digit 'o'
We can write a better a function:
octalDigitToInt :: Char -> Maybe Int
octalDigitToInt c | c `elem` "01234567" = Just (digitToInt c)
| otherwise = Nothing
We can use that to convert an octal number into a sequence of digits, using traverse instead of fmap:
parseString' :: [Char] -> Maybe [Int]
parseString' = traverse octalDigitToInt
Valid octal string produce a Just value:
> parseString' "123"
Just [1,2,3]
while invalid strings produce a Nothing value:
> parseString' "193"
Nothing
> parseString' "foo"
Nothing
(Think of traverse as being a function that not only applies a function to a list of values, but only produces a list of results if each application succeeds. More precisely, it's a combination of sequence and fmap:
traverse f = sequence . fmap f
where sequence is the function that "inverts" a value of type [Maybe Int] to a value of type Maybe [Int].)
With a more robust version of parseString, we need to adapt octoDec to handle the possibility that parsing will fail. We do that by using fmap to "lift" horner into the Maybe functor.
octoDec' :: [Char] -> Maybe Int
octoDec' s = fmap horner (parseString' s) -- or octoDec = fmap horner . parseString'
So ... I messed up a recording in CSV format:
23,95489,0,20,9888
Due to language settings floating point numbers were written with commas as seperator ... in a comma separated value file ...
Problem is that the file does not have a nice formatting for every float. Some have no point at all and the number of numbers behind the point varies too.
My idea was to build a MegaParsec parser that would try to read every possible floating point formatting, move on and if back track if it finds an error.
Eg for the example above:
read 23,95489 -> good
read 0,20 -> good (so far)
read 9888 -> error (because value is too high for column (checked by guard))
(back tracking to 2.) read 0 -> good again
read 20,9888 -> good
done
I've implemented that as (pseudo code here):
floatP = try pointyFloatP <|> unpointyFloatP
lineP = (,,) <$> floatP <* comma <*> floatP <* comma <*> floatP <* comma
My problem is that apparently the try only works in the 'current' float. There is no backtracking to previous positions. Is this correct?
And if so ... how would I go about implementing further back tracking?
How far does “try” back track?
The parser try p consumes exactly as much input as p if p parses successfully, otherwise it does not consume any input at all. So if you look at that in terms of backtracking, it backtracks to the point where you were when you invoked it.
My problem is that apparently the try only works in the 'current' float. There is no backtracking to previous positions. Is this correct?
Yes, try does not "unconsume" input. All it does is to recover from a failure in the parser you give it without consuming any input. It does not undo the effects of any parsers that you've applied previously, nor does it affect subsequent parsers that you apply after try p succeeded.
And if so ... how would I go about implementing further back tracking?
Basically what you want is to not only know whether pointyFloatP succeeds on the current input, but also whether the rest of your lineP would succeed after successfully pointyFloatP - and if it doesn't you want to backtrack back to before you applied pointyFloatP. So basically you want the parser for the whole remaining line in the try, not just the float parser.
To achieve that you can make floatP take the parser for the remaining line as an argument like this:
floatP restP = try (pointyFloatP <*> restP) <|> unpointyFloatP <*> restP
Note that this kind of backtracking isn't going to be very efficient (but I assume you knew that going in).
Update: Include a custom monadic parser for more complex rows.
Using the List Monad for Simple Parsing
The list monad makes a better backtracking "parser" than Megaparsec. For example, to parse the cells:
row :: [String]
row = ["23", "95489", "0", "20", "9888"]
into exactly three columns of values satisfying a particular bound (e.g., less than 30), you can generate all possible parses with:
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Applicative
rowResults :: [String] -> [[Double]]
rowResults = cols 3
where cols :: Int -> [String] -> [[Double]]
cols 0 [] = pure [] -- good, finished on time
cols 0 _ = empty -- bad, didn't use all the data
-- otherwise, parse exactly #n# columns from cells #xs#
cols n xs = do
-- form #d# from one or two cells
(d, ys) <- num1 xs <|> num2 xs
-- only accept #d < 30#
guard $ d < 30
ds <- cols (n-1) ys
return $ d : ds
-- read number from a single cell
num1 (x:xs) | ok1 x = pure (read x, xs)
num1 _ = empty
-- read number from two cells
num2 (x:y:zs) | ok1 x && ok2 y = pure (read (x ++ "." ++ y), zs)
num2 _ = empty
-- first cell: "0" is okay, but otherwise can't start with "0"
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- second cell: can't end with "0" (or *be* "0")
ok2 xs = last xs /= '0'
The above list-based parser tries to reduce ambiguity by assuming that if "xxx,yyy" is a number, the "xxx" won't start with zeros (unless it's just "0"), and the "yyy" won't end with a zero (or, for that matter, be a single "0"). If this isn't right, just modify ok1 and ok2 as appropriate.
Applied to row, this gives the single unambiguous parse:
> rowResults row
[[23.95489,0.0,20.9888]]
Applied to an ambiguous row, it gives all parses:
> rowResults ["0", "12", "5", "0", "8601"]
[[0.0,12.5,0.8601],[0.0,12.5,0.8601],[0.12,5.0,0.8601]]
Anyway, I'd suggest using a standard CSV parser to parse your file into a matrix of String cells like so:
dat :: [[String]]
dat = [ ["23", "95489", "0", "20", "9888"]
, ["0", "12", "5", "0", "8601"]
, ["23", "2611", "2", "233", "14", "422"]
]
and then use rowResults above get the row numbers of rows that were ambiguous:
> map fst . filter ((>1) . snd) . zip [1..] . map (length . rowResults) $ dat
[2]
>
or unparsable:
> map fst . filter ((==0) . snd) . zip [1..] . map (length . rowResults) $ dat
[]
>
Assuming there are no unparsable rows, you can regenerate one possible fixed file, even if some rows are ambiguous, but just grabbing the first successful parse for each row:
> putStr $ unlines . map (intercalate "," . map show . head . rowResults) $ dat
23.95489,0.0,20.9888
0.0,12.5,0.8601
23.2611,2.233,14.422
>
Using a Custom Monad based on the List Monad for More Complex Parsing
For more complex parsing, for example if you wanted to parse a row like:
type Stream = [String]
row0 :: Stream
row0 = ["Apple", "15", "1", "5016", "2", "5", "3", "1801", "11/13/2018", "X101"]
with a mixture of strings and numbers, it's actually not that difficult to write a monadic parser, based on the list monad, that generates all possible parses.
The key idea is to define a parser as a function that takes a stream and generates a list of possible parses, with each possible parse represented as a tuple of the object successfully parsed from the beginning of the stream paired with the remainder of the stream. Wrapped in a newtype, our parallel parser would look like:
newtype PParser a = PParser (Stream -> [(a, Stream)]) deriving (Functor)
Note the similarity to the type ReadS from Text.ParserCombinators.ReadP, which is also technically an "all possible parses" parser (though you usually only expect one, unambiguous parse back from a reads call):
type ReadS a = String -> [(a, String)]
Anyway, we can define a Monad instance for PParser like so:
instance Applicative PParser where
pure x = PParser (\s -> [(x, s)])
(<*>) = ap
instance Monad PParser where
PParser p >>= f = PParser $ \s1 -> do -- in list monad
(x, s2) <- p s1
let PParser q = f x
(y, s3) <- q s2
return (y, s3)
There's nothing too tricky here: pure x returns a single possible parse, namely the result x with an unchanged stream s, while p >>= f applies the first parser p to generate a list of possible parses, takes them one by one within the list monad to calculate the next parser q to use (which, as per usual for a monadic operation, can depend on the result of the first parse), and generates a list of possible final parses that are returned.
The Alternative and MonadPlus instances are pretty straightforward -- they just lift emptiness and alternation from the list monad:
instance Alternative PParser where
empty = PParser (const empty)
PParser p <|> PParser q = PParser $ \s -> p s <|> q s
instance MonadPlus PParser where
To run our parser, we have:
parse :: PParser a -> Stream -> [a]
parse (PParser p) s = map fst (p s)
and now we can introduce primitives:
-- read a token as-is
token :: PParser String
token = PParser $ \s -> case s of
(x:xs) -> pure (x, xs)
_ -> empty
-- require an end of stream
eof :: PParser ()
eof = PParser $ \s -> case s of
[] -> pure ((), s)
_ -> empty
and combinators:
-- combinator to convert a String to any readable type
convert :: (Read a) => PParser String -> PParser a
convert (PParser p) = PParser $ \s1 -> do
(x, s2) <- p s1 -- for each possible String
(y, "") <- reads x -- get each possible full read
-- (normally only one)
return (y, s2)
and parsers for various "terms" in our CSV row:
-- read a string from a single cell
str :: PParser String
str = token
-- read an integer (any size) from a single cell
int :: PParser Int
int = convert (mfilter ok1 token)
-- read a double from one or two cells
dbl :: PParser Double
dbl = dbl1 <|> dbl2
where dbl1 = convert (mfilter ok1 token)
dbl2 = convert $ do
t1 <- mfilter ok1 token
t2 <- mfilter ok2 token
return $ t1 ++ "." ++ t2
-- read a double that's < 30
dbl30 :: PParser Double
dbl30 = do
x <- dbl
guard $ x < 30
return x
-- rules for first cell of numbers:
-- "0" is okay, but otherwise can't start with "0"
ok1 :: String -> Bool
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- rules for second cell of numbers:
-- can't be "0" or end in "0"
ok2 :: String -> Bool
ok2 xs = last xs /= '0'
Then, for a particular row schema, we can write a row parser as we normally would with a monadic parser:
-- a row
data Row = Row String Int Double Double Double
Int String String deriving (Show)
rowResults :: PParser Row
rowResults = Row <$> str <*> int <*> dbl30 <*> dbl30 <*> dbl30
<*> int <*> str <*> str <* eof
and get all possible parses:
> parse rowResults row0
[Row "Apple" 15 1.5016 2.0 5.3 1801 "11/13/2018" "X101"
,Row "Apple" 15 1.5016 2.5 3.0 1801 "11/13/2018" "X101"]
>
The full program is:
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Monad
import Control.Applicative
type Stream = [String]
newtype PParser a = PParser (Stream -> [(a, Stream)]) deriving (Functor)
instance Applicative PParser where
pure x = PParser (\s -> [(x, s)])
(<*>) = ap
instance Monad PParser where
PParser p >>= f = PParser $ \s1 -> do -- in list monad
(x, s2) <- p s1
let PParser q = f x
(y, s3) <- q s2
return (y, s3)
instance Alternative PParser where
empty = PParser (const empty)
PParser p <|> PParser q = PParser $ \s -> p s <|> q s
instance MonadPlus PParser where
parse :: PParser a -> Stream -> [a]
parse (PParser p) s = map fst (p s)
-- read a token as-is
token :: PParser String
token = PParser $ \s -> case s of
(x:xs) -> pure (x, xs)
_ -> empty
-- require an end of stream
eof :: PParser ()
eof = PParser $ \s -> case s of
[] -> pure ((), s)
_ -> empty
-- combinator to convert a String to any readable type
convert :: (Read a) => PParser String -> PParser a
convert (PParser p) = PParser $ \s1 -> do
(x, s2) <- p s1 -- for each possible String
(y, "") <- reads x -- get each possible full read
-- (normally only one)
return (y, s2)
-- read a string from a single cell
str :: PParser String
str = token
-- read an integer (any size) from a single cell
int :: PParser Int
int = convert (mfilter ok1 token)
-- read a double from one or two cells
dbl :: PParser Double
dbl = dbl1 <|> dbl2
where dbl1 = convert (mfilter ok1 token)
dbl2 = convert $ do
t1 <- mfilter ok1 token
t2 <- mfilter ok2 token
return $ t1 ++ "." ++ t2
-- read a double that's < 30
dbl30 :: PParser Double
dbl30 = do
x <- dbl
guard $ x < 30
return x
-- rules for first cell of numbers:
-- "0" is okay, but otherwise can't start with "0"
ok1 :: String -> Bool
ok1 "0" = True
ok1 (c:_) | c /= '0' = True
ok1 _ = False
-- rules for second cell of numbers:
-- can't be "0" or end in "0"
ok2 :: String -> Bool
ok2 xs = last xs /= '0'
-- a row
data Row = Row String Int Double Double Double
Int String String deriving (Show)
rowResults :: PParser Row
rowResults = Row <$> str <*> int <*> dbl30 <*> dbl30 <*> dbl30
<*> int <*> str <*> str <* eof
row0 :: Stream
row0 = ["Apple", "15", "1", "5016", "2", "5", "3", "1801", "11/13/2018", "X101"]
main = print $ parse rowResults row0
Off-the-shelf Solutions
I find it a little surprising I can't find an existing parser library out there that provides this kind of "all possible parses" parser. The stuff in Text.ParserCombinators.ReadP takes the right approach, but it assumes that you're parsing characters from a String rather than arbitrary tokens from some other stream (in our case, Strings from a [String]).
Maybe someone else can point out an off-the-shelf solution that would save you from having to role your own parser type, instances, and primitives.
From a String like "abc123def45" i want to get -> [123, 45].
I have the following now:
getDecimals :: String -> [Int]
getDecimals xs = [ digitToInt x | x<-xs , isDigit x]
Only this method is returning -> [1,2,3,4,5].
How can i do this?
Tnx!
If you are using Data.List.Split you can do this.
import Data.List.Split
import Data.Char
getDecimals :: String -> [Int]
getDecimals = map read . wordsBy (not . isDigit)
Here is a (quite long) on-liner to do this:
import Data.List
import Data.Char
getDecimals = ((map (read::String->Int)).(filter (isNumber.head)).(groupBy (\a b -> (isNumber a) && (isNumber b))))
Now let's break it down:
(
( map (read::String->Int) ). -- Go over the list of numerical strings and read them as Ints
( filter (isNumber.head) ). -- Filter out the strings which are not begining with digit
( groupBy -- Split the given list based on the following comparison function:
(\a b -> (isNumber a) && (isNumber b)) -- The comparison function to return true if both arguments are digits
)
)
Since we are using the . function, which is function composition, the functions above are applied in the order bottom to top to the given argument list. I am pretty sure there is more elegant ways to do this, but I can't think of any at this moment.
I've never played with regex-applicative before, so I guess I'll give it a go!
NOTE: the cleanest version, but the least interesting, is way down at the bottom.
The first version here is written to use just one regular expression, which means it's not at all lazy (oy!).
import Text.Regex.Applicative
import Data.Char
fakeDigitToInt :: Char -> Int
fakeDigitToInt x = ord x - ord '0'
digit = fakeDigitToInt <$> psym isDigit
addDigit big small = 10*big+small
number = addDigit <$> reFoldl Greedy addDigit 0 digit <*> digit
spacers = many (psym $ not . isDigit)
numbersInCrud = many (spacers *> number) <* spacers
readNumbersFromCrud = maybe [] id . match numbersInCrud
To make a lazy version, it's necessary to break things up a bit more, using more features of the parsing system. While I'm at it, I'll fix up the types a bit:
import Text.Regex.Applicative
import Data.Char
import Data.List (unfoldr)
fakeDigitToInt :: Char -> Int
fakeDigitToInt x = ord x - ord '0'
digit :: Num n => RE Char n
digit = fromIntegral . fakeDigitToInt <$> psym isDigit
addDigit big small = 10*big+small
number :: Num n => RE Char n
number = addDigit <$> reFoldl Greedy addDigit 0 digit <*> digit
spacers = many (psym $ not . isDigit)
pullNumber :: Num n => String -> Maybe (n, String)
pullNumber = findLongestPrefix (spacers *> number)
readNumbersFromCrud :: Num n => String -> [n]
readNumbersFromCrud = unfoldr pullNumber
The cleanest version
This is kind of boring, but it is simple:
import Text.Regex.Applicative
import Text.Regex.Applicative.Common
import Data.Char
import Data.List (unfoldr)
spacers = many (psym $ not . isDigit)
pullNumber :: Num n => String -> Maybe (n, String)
pullNumber = findLongestPrefix (spacers *> decimal)
readNumbersFromCrud :: Num n => String -> [n]
readNumbersFromCrud = unfoldr pullNumber
And because I couldn't resist, here's the (almost) one-liner:
import Text.Regex.Applicative
import Text.Regex.Applicative.Common
import Data.Char
import Data.List (unfoldr)
readNumbersFromCrud :: Num n => String -> [n]
readNumbersFromCrud = unfoldr . findLongestPrefix $
many (psym $ not . isDigit) *> decimal
I want to lazily read user input and do something with it line by line. But if user ends a line with , (comma) followed by any number of spaces (including zero), I want give him opportunity to finish his input on the next line.
And here is what I've got:
import System.IO
import Data.Char
chop :: String -> [String]
chop = f . map (++ "\n") . lines
where f [] = []
f [x] = [x]
f (x : y : xs) = if (p . tr) x
then f ((x ++ y) : xs)
else x : f (y : xs)
p x = (not . null) x && ((== ',') . last) x
tr xs | all isSpace xs = ""
tr (x : xs) = x :tr xs
main :: IO ()
main =
do putStrLn "Welcome to hell, version 0.1.3!"
putPrompt
mapM_ process . takeWhile (/= "quit\n") . chop =<< getContents
where process str = putStr str >> putPrompt
putPrompt = putStr ">>> " >> hFlush stdout
Sorry, it doesn't work at all. Bloody mess.
P.S. I want to preserve \n characters on end of every chunk. Currently I add them manually with map (++ "\n") after lines.
How about changing the type of chop a little:
readMultiLine :: IO [String]
readMultiLine = do
ln <- getLine
if (endswith (rstrip ln) ",") then
liftM (ln:) readMultiLine
else
return [ln]
Now you know that if the last list is not empty, then the user didn't finish typing (the last input ended with ',').
Of course, either import Data.String.Utils, or write your own. Could be as simple as:
endswith xs ys = (length xs >= length ys)
&& (and $ zipWith (==) (reverse xs) (reverse ys))
rstrip = reverse . dropWhile isSpace . reverse
But I missed the point at first. Here's the actual thing.
unfoldM :: (Monad m) => (a -> Maybe (m b, m a)) -> a -> m [b]
unfoldM f z = case f z of
Nothing -> return []
Just (x, y) -> liftM2 (:) x $ y >>= unfoldM f
main = unfoldM (\x -> if (x == ["quit"]) then Nothing
else Just (print x, readMultiLine)) =<< readMultiLine
The reason is, you need to be able to insert the "action" to be done on input between reading one multi-line input and the next. Here print x is the action inserted between two readMultiLine
Since you have questions about getContents, let me add. Even though getContents provides a lazy String, its effectful changes to the world are ordered with the subsequent effects of processing the list. But the processing of the list attempts to insert effects between effects of reading particular list items. To do that, you need a function that exposes the chain of effects, so you can insert your own effects between them.
You can do this using pipes, preserving the laziness of the user's input
import Data.Char (isSpace)
import Pipes
import qualified Pipes.Prelude as Pipes
endsWithComma :: String -> Bool
endsWithComma str =
case (dropWhile isSpace $ reverse str) of
',':_ -> True
_ -> False
finish :: Monad m => Pipe String String m ()
finish = do
str <- await
yield str
if endsWithComma str
then do
str' <- await
yield str'
else finish
user :: Producer String IO ()
user = Pipes.stdinLn >-> finish
You can then hook up the user Producer to any downstream Consumer. For example, to echo the stream back out you can write:
main = runEffect (user >-> Pipes.stdoutLn)
To learn more about pipes you can read the tutorial.
Sorry, I wrote something wrong in a comment and I thought that now that I understood what you were trying to do, I'd give an answer with a little more substance. The core idea is that you're going to need a state buffer while you loop through the string, as far as I can tell. You have f :: [String] -> [String] but you'll need an extra string of buffer before you can solve this puzzle.
So let me assume an answer which looks like:
chop = joinCommas "" . map (++ "\n") . lines
Then the structure of joinCommas is going to look like:
import Data.List (isSuffixOf)
-- override with however you want to handle the ",\n" between lines.
joinLines = (++)
incomplete = isSuffixOf ",\n"
joinCommas :: String -> [String] -> [String]
joinCommas prefix (line : rest)
| incomplete prefix = joinCommas (joinLines prefix line) rest
| otherwise = prefix : joinCommas line rest
joinCommas prefix []
| incomplete prefix = error "Incomplete input"
| otherwise = [prefix]
The prefix stores up lines until it doesn't end with ",\n" at which point it emits the prefix and continues with the rest of the lines. On EOF we process the last line unless that line is incomplete.
Im working through the exercises on wikibooks/haskell and there is an exercise in the MonadPlus-chapter that wants you to write this hexChar function. My function works as shown below, but the thing is that when I try to switch the 2 helper parsers (digitParse and alphaParse) around the function ceases to work properly. If I switch them around I can only parse digits and not alphabetic chars anymore.
Why is this so?
char :: Char -> String -> Maybe (Char, String)
char c s = do
let (c':s') = s
if c == c' then Just (c, s') else Nothing
digit :: Int -> String -> Maybe Int
digit i s | i > 9 || i < 0 = Nothing
| otherwise = do
let (c:_) = s
if read [c] == i then Just i else Nothing
hexChar :: String -> Maybe (Char, String)
hexChar s = alphaParse s `mplus` digitParse s -- cannot switch these to parsers around!!
where alphaParse s = msum $ map ($ s) (map char (['a'..'f'] ++ ['A'..'F']))
digitParse s = do let (c':s') = s
x <- msum $ map ($ s) (map digit [0..9])
return (intToDigit x, s')
if read [c] == i then Just i else Nothing
The marked code has a flaw. You're using Int's Read instance, e.g. read :: String -> Int. But if it's not possible to parse [c] as an int (e.g. "a"), read will throw an exception:
> digit 1 "doesnt start with a digit"
*** Exception: Prelude.read: no parse
> -- other example
> (read :: String -> Int) "a"
*** Exception: Prelude.read: no parse
Instead, go the other way:
if [c] == show i then Just i else Nothing
This will always works, since show won't fail (not counting cases where bottom is involved).