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
Related
I would like to know what is the best way to get a tuple from data read from the input in Haskell. I often encounter this problem in competitive programming when the input is made up of several lines that contain space-separated integers. Here is an example:
1 3 10
2 5 8
10 11 0
0 0 0
To read lines of integers, I use the following function:
readInts :: IO [Int]
readInts = fmap (map read . words) getLine
Then, I transform these lists into tuples with of the appropriate size:
readInts :: IO (Int, Int, Int, Int)
readInts = fmap ((\l -> (l !! 0, l !! 1, l !! 2, l !! 3)) . map read . words) getLine
This approach does not seem very idiomatic to me.
The following syntax is more readable but it only works for 2-tuples:
readInts :: IO (Int, Int)
readInts = fmap ((\[x, y] -> (x, y)) . map read . words) getLine
(EDIT: as noted in the comments, the solution above works for n-tuples in general).
Is there an idiomatic way to initialize tuples from lists of integers without having to use !! in Haskell? Alternatively, is there a different approach to processing this type of input?
How about this:
readInts :: IO (<any tuple you like>)
readInts = read . ("(" ++) . (++ ")") . intercalate "," . words <$> getLine
Given that the context is 'competitive programming' (something I'm only dimly aware of as a concept), I'm not sure that the following offers a particularly competitive alternative, but IMHO I'd consider it idiomatic to use one of several available parser combinators.
The base package comes with a module called Text.ParserCombinators.ReadP. Here's how you could use it to parse the input file from the linked article:
module Q57693986 where
import Text.ParserCombinators.ReadP
parseNumber :: ReadP Integer
parseNumber = read <$> munch1 (`elem` ['0'..'9'])
parseTriple :: ReadP (Integer, Integer, Integer)
parseTriple =
(,,) <$> parseNumber <*> (char ' ' *> parseNumber) <*> (char ' ' *> parseNumber)
parseLine :: ReadS (Integer, Integer, Integer)
parseLine = readP_to_S (parseTriple <* eof)
parseInput :: String -> [(Integer, Integer, Integer)]
parseInput = concatMap (fmap fst . filter (null . snd)) . fmap parseLine . lines
You can use the parseInput against this input file:
1 3 10
2 5 8
10 11 0
0 0 0
Here's a GHCi session that parses that file:
*Q57693986> parseInput <$> readFile "57693986.txt"
[(1,3,10),(2,5,8),(10,11,0),(0,0,0)]
Each parseLine function produces a list of tuples that match the parser; e.g.:
*Q57693986> parseLine "11 32 923"
[((11,32,923),"")]
The second element of the tuple is any remaining String still waiting to be parsed. In the above example, parseLine has completely consumed the line, which is what I'd expect for well-formed input, so the remaining String is empty.
The parser returns a list of alternatives if there's more than one way the input could be consumed by the parser, but again, in the above example, there's only one suggested alternative, as the line has been fully consumed.
The parseInput function throws away any tuple that hasn't been fully consumed, and then picks only the first element of any remaining tuples.
This approach has often served me with puzzles such as Advent of Code, where the input files tend to be well-formed.
This is a way to generate a parser that works generically for any tuple (of reasonable size). It requires the library generics-sop.
{-# LANGUAGE DeriveGeneric, DeriveAnyClass,
FlexibleContexts, TypeFamilies, TypeApplications #-}
import GHC.Generics
import Generics.SOP
import Generics.SOP (hsequence, hcpure,Proxy,to,SOP(SOP),NS(Z),IsProductType,All)
import Data.Char
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
import Text.Read
componentP :: Read a => ReadP a
componentP = munch isSpace *> readPrec_to_P readPrec 1
productP :: (IsProductType a xs, All Read xs) => ReadP a
productP =
let parserOutside = hsequence (hcpure (Proxy #Read) componentP)
in Generics.SOP.to . SOP . Z <$> parserOutside
For example:
*Main> productP #(Int,Int,Int) `readP_to_S` " 1 2 3 "
[((1,2,3)," ")]
It allows components of different types, as long as they all have a Read instance.
It also parses records that have a Generics.SOP.Generic instance:
data Stuff = Stuff { x :: Int, y :: Bool }
deriving (Show,GHC.Generics.Generic,Generics.SOP.Generic)
For example:
*Main> productP #Stuff `readP_to_S` " 1 True"
[(Stuff {x = 1, y = True},"")]
Im a beginner to haskell and I've tried to create a function which counts the numbers of a character in a string. The problem I have is that I am only able to count either the number of occurences of a uppercase or a lowercase character. I want to count both of them. E.g. For the string Mum the result for counting m should be 2.
My function right now looks like this:
import Data.Char
countList :: [Char] -> Char -> Int
countList str c = length $ filter (== c) str
What would your suggestions on solving this be?
import Data.Char (toUpper)
countChar :: Char -> [Char] -> Int
countChar char = length . filter (\c -> toUpper c == toUpper char)
countChar 's' "Stdudents" => 2
countChar 'S' "Sstudents" => 3
countChar 'S' "$tudent$$" => 0
Given a character 'char', filter the entire string for any character whose uppercase matches the uppercase of 'char'. Feed the new filtered string to the 'length' function to get the total count.
A neat way to obtain the toUpper c == toUpper char comparison is to use the on combinator:
import Data.Function
countChar char = length . filter (on (==) toUpper char)
Just transform all to lowercase:
import Data.Char
countList :: [Char] -> Char -> Int
countList str c = length $ filter (== toLower c) $ map toLower str
You can also use just use fold, here a ghci example:
Prelude Data.Char> let countList = \str c -> foldl (\x y -> x + if ((toLower y) == (toLower c)) then 1 else 0) 0 str
Prelude Data.Char> countList "AAaabCC" 'a'
4
I know the Data.List module comes with the predefined function groupBy which i want to use to split a string into groups of consecutive vowels and non-vowels. the format of the function groupBy is as follows:
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
How can I use this format to do the splitting for a string?
Thanks
Like this
ghci> import Data.Char
ghci> import Data.List
ghci> groupBy (const isAlphaNum) "A bunch of words and numbers34"
["A"," bunch"," of"," words"," and"," numbers34"]
Or
ghci> groupBy (const isAlpha) "A bunch of words and numbers34"
["A"," bunch"," of"," words"," and"," numbers","3","4"]
Edit: Since there has been no indication that a solution has been found to the extended problem, in the interest of keeping up the standard of SO I shall complete the answer to the problem:
import Data.List
isVowel :: Char -> Bool
isVowel c = c `elem` "aeiouy"
bothVowelConsonant :: Char -> Char -> Bool
bothVowelConsonant a b = all isVowel [a,b] || not (any isVowel [a,b])
splitByVowel :: String -> [String]
splitByVowel s = groupBy bothVowelConsonant s
Is there a way to read an integer from the console in Haskell? I'm asking for something pretty much like C++'s cin or Java's Scanner.nextInt().
And by that I mean that given this input:
1 2 3
2 3
4 25 12 7
1
I should be able to read them all, not at the same time (maybe reading 4 of them, doing some calculations and then read the rest) ignoring the fact that they are in separate lines.
The easiest solution is probably
getAll :: Read a => IO [a]
getAll = fmap (fmap read . words) getContents
getInts :: IO [Int]
getInts = getAll
which will read all input into a single list.
When in doubt, use Parsec! (not always, and not really, but who cares)
import Text.ParserCombinators.Parsec
import Text.Parsec.Numbers
value = do
spaces
num <- parseFloat
return num
line = many value
then "rinse and repeat", with getLine until you EOF.
Note: you can do it without Parsec using read and friends, but this way is more extendable and preferred for more complicated grammars.
Using Parsec:
import Text.ParserCombinators.Parsec
import Text.Parsec.Numbers
import Control.Applicative ((*>), (<*))
line = spaces *> many1 (parseFloat <* spaces)
main = putStrLn "Enter numbers:" >> fmap (parse line "") getLine >>= print
Running it:
$ ghc parsenums.hs
$ ./parsenums
Enter numbers:
345 23 654 234
[345.0,23.0,654.0,234.0]
A more "manual" way to do it would be something like:
import Data.Char (isDigit, isSpace)
getInts :: String -> [Int]
getInts s = case span isDigit (dropWhile isSpace s) of
("", "") -> []
("", s) -> error $ "Invalid input: " ++ s
(digits, rest) -> (read digits :: Int) : getInts rest
Which might be much clearer to see how it works. In fact, here's one that's completely from the ground up:
getInts :: String -> [Int]
getInts s = case span isDigit (dropWhile isSpace s) of
("", "") -> []
("", s) -> error $ "Invalid input: " ++ s
(digits, rest) -> strToInt digits : getInts rest
isDigit :: Char -> Bool
isDigit c = '0' <= c && c <= '9'
isSpace :: Char -> Bool
isSpace c = c `elem` " \t\n\r"
charToInt :: Char -> Int
charToInt c = fromEnum c - 48
strToInt :: String -> Int
strToInt s = go 0 s where
go n [] = n
go n (c:rest) = go (n * 10 + charToInt c) rest
I'm trying to write a function that takes the longest number from a String in Haskell.
Example: "Test12 Test123 Test1234"
This should return 1234 because 1234 is the longest number in this String.
This is how my code currently looks like:
import Data.Char
longNumber :: String -> Int
longNumber n = length (filter ((> 1) . length . filter isDigit) . words) n
Can anyone help me here?
It looks like you want something like:
longNumber :: String -> Int
longNumber = read . maximumBy (comparing length) . map (filter isDigit) . words
import Data.Char
import Data.Function
import Data.List
takeAllNumbers :: String → [String]
takeAllNumbers "" = []
takeAllNumbers s = let (n,s') = takeNumber s
in n:takeAllNumbers s'
where takeNumber = span isDigit ∘ dropWhile (not ∘ isDigit)
maxNumber :: String → Maybe Int
maxNumber "" = Nothing
maxNumber s = let allNums = takeAllNumbers s
in if null allNums
then Nothing
else Just $ read $ maximumBy (compare `on` length) allNums
The function takeAllNumbers extracts all the numbers in the given String while maxNumber selects the number with the max length in its String form. Note that maxNumber returns Maybe Int because it is possible that in the String there are no numbers.
You are making an assumption that numbers are always in separate words. What if your string had no spaces? The words function would not help you, and simply getting rid of of non digit characters could cause you issues. For example "ab1c2d3 test12" would become `["123", "12"].
Also, you will need to return a Maybe Int (what if there were no numbers?)
Below is my first attempt at the problem.
import Data.Ord (comparing)
import Data.Char (isDigit)
import Data.List (maximumBy, null, groupBy)
longestNumber :: String -> Maybe Int
longestNumber s
| null nums = Nothing
| otherwise = Just $ read $ maximumBy (comparing length) nums
where
nums = filter (isDigit . head) groups
groups = groupBy (\a b -> isDigit a == isDigit b) s
Use the 'takeWhile' function with 'isDigit' and recursion.
import Data.Char
import Data.List
import Data.Function
getLongest [] = []
getLongest l = getMax $ getNumbers l []
where getNumbers [] ls = ls
getNumbers l#(x:xs) ls
| isDigit x = getNumbers (dropWhile isDigit l) (ls ++ [takeWhile isDigit l])
| otherwise = getNumbers xs ls
getMax ls = if (ls == []) then [] else (maximumBy (compare `on` length) ls)