Related
My input is:
Plaster ["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
What I'm trying to get:
["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
My code for now:
go = do --print "Enter file name"
--path <- getLine
file <- (readFile "1.txt")
print file
let list = consume file
print list
let content = (wordsWhen (=='"') list)
print content
print (content !! 0)
print (content !! 1)
print (content !! 2)
wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s = case dropWhile p s of
"" -> []
", " -> []
s' -> w : wordsWhen p s''
where (w, s'') = break p s'
consume [] = []
consume ('[':xs) = consume' xs
consume (_ :xs) = consume xs
consume' [] = []
consume' (']':xs) = []
consume' (x :xs) = x : consume' xs
So what I'm doing is
Read file from destination (now hardcoded for testing)
Get rid of the word "Plaster" with consume
Get all strings from file with wordsWhen
I tried different separators for wordsWhen, but I can't get what I need. In current form the output is:
"Plaster [\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\"]"
"\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\""
["BD..",", ",".GA.D",", ",".FEG",", ","ABDCF",", ","E..."]
"BD.."
", "
".GA.D"
Which is quite accurate, but I want to get rid of this words that contains only commas. I can change the separator to comma (which it's supposed to be, I think), but then output is given with all this slashes and quotation marks, like this:
"Plaster [\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\"]"
"\"BD..\", \".GA.D\", \".FEG\", \"ABDCF\", \"E...\""
["\"BD..\""," \".GA.D\""," \".FEG\""," \"ABDCF\""," \"E...\""]
"\"BD..\""
" \".GA.D\""
" \".FEG\""
Is there a way to fix my code? Or should I do it in a different way?
EDIT: As it is my exercise, I can only use standard types and functions.
Well, you could cheat by defining a datatype with a Read instance that matches your existing input:
{-# OPTIONS_GHC -Wall -Werror -Wno-name-shadowing #-}
module Main where
data Input = Plaster [String] deriving (Read, Show)
main :: IO ()
main = do
Plaster xs <- readIO =<< readFile "1.txt"
_ <- traverse print (zip [0 :: Int ..] xs)
return ()
This works perfectly for me with ghc-8.0.2:
$ cat "1.txt"
Plaster ["BD..", ".GA.D", ".FEG", "ABDCF", "E..."]
$ ghc --make SO44269043.hs && ./SO44269043
(0,"BD..")
(1,".GA.D")
(2,".FEG")
(3,"ABDCF")
(4,"E...")
Alternately, you could define your own read instance:
data Input = Plaster [String]
instance Read Input where
readsPrec p = readParen (p >= 10) . runR $ do
Plaster <$> (string "Plaster" *> many1 whitespace *> R readList)
If you're unfamiliar with <$> and *>, it may be a little easier to read this as
readsPrec p = readParen (p >= 10) . runR $ do
_ <- string "Plaster"
_ <- many1 whitespace
xs <- R readList
return (Plaster xs)
Even without imports, it's not a lot of code to define a parser type R, basically just a wrapper that lets you define a monad instance for String -> [(a, String)]:
newtype R a = R { runR :: ReadS a }
instance Functor R where
fmap f = R . fmap (map (\(a, s) -> (f a, s))) . runR
instance Applicative R where
pure a = R $ \s -> [(a, s)]
mf <*> ma = R $ \s -> do
(f, s) <- runR mf s
(a, s) <- runR ma s
return (f a, s)
instance Monad R where
m >>= f = R $ \s -> do
(a, s) <- runR m s
runR (f a) s
The >>= (or bind) operator just means "parse some of the string
with the parser on the left, then parse the rest of the string
with the after passing the resulting value to the function on the right."
We get R readList :: R [String] for free now, so all we need to do
is skip the initial "Plaster" and any whitespace between that and the
list of strings:
string :: String -> R String
string = traverse char
many1 :: R a -> R [a]
many1 r = loop where
loop = (:) <$> r <*> (loop <|> return [])
whitespace :: R Char
whitespace = char ' ' <|> char '\t' <|> char '\n' <|> char '\r'
Normally we'd use <|> from GHC.Base, but it's not hard to define a one-off here. Basically
r <|> r' means "try to parse with r, and if it fails, try to parse with r' instead"
(<|>) :: R a -> R a -> R a
r <|> r' = R $ \s -> runR r s ++ runR r' s
And now all we need is the ability to match a single character:
char :: Char -> R Char
char c = R $ \s -> case s of
(c' : s) | c == c' -> [(c, s)]
_ -> []
If even using Prelude.readList is too easy, we can define our own parsers for lists and quoted strings:
readsPrec p = readParen (p >= 10) . runR $ do
Plaster <$> (string "Plaster" *> many1 whitespace *> listOf quotedString)
Where lists just have a leading '[', a trailing ']', and some number of delimited terms:
listOf :: R a -> R [a]
listOf term = char '[' *> (term `sepBy` string ", ") <* char ']'
sepBy :: R a -> R b -> R [a]
sepBy term delim = sepBy1 term delim <|> return []
sepBy1 :: R a -> R b -> R [a]
sepBy1 term delim = loop where
loop = (:) <$> term <*> ((delim *> loop) <|> return [])
Similarly, a quoted string just has a leading '"', a trailing '"', and some number of escaped characters:
quotedString :: R String
quotedString = char '"' *> many escapedChar <* char '"'
many :: R a -> R [a]
many r = many1 r <|> return []
escapedChar :: R Char
escapedChar = R $ \s -> case s of
'\\' : '\\' : s -> [('\\', s)]
'\\' : '"' : s -> [('"', s)]
c : s | c /= '\\' && c /= '"' -> [(c, s)]
_ -> []
It's worth noting the similarity between many/many1 and sepBy/sepBy1 - if we were really
lazy, we could define one in terms of the other:
many1 r = r `sepBy1` return ()
term `sepBy1` delim = (:) <$> term <*> many (delim *> term)
This is how it could be done:
import System.Environment
import System.IO
import Data.Maybe
import Text.Read
readStringList :: String -> Maybe [String]
readStringList = readMaybe
main = do --print "Enter file name"
handle <- openFile "1.txt" ReadMode
hSeek handle AbsoluteSeek 8
file <- hGetContents handle
let list = fromJust (readStringList file )
print list
let filterThis = "," :: String
let filtered = filter (/=filterThis) list
print filtered
To get first command line argument, use getArgs.
Here is a quick and dirty parser.
Be careful, it only works for well formed input, is not performant and code is not factorised. But there is no cheating ;)
Maybe it could give you some inspiration to solve your exercise.
plaster :: String -> String
plaster ('P':'l':'a':'s':'t':'e':'r':' ':xs) = xs
plaster s = undefined
brackets :: String -> String
brackets ('[':xs) = brackets xs
brackets (x:']':_) = [x]
brackets (x:xs) = x:brackets xs
quotes :: String -> String
quotes ('"':xs) = quotes xs
quotes (x:'"':_) = [x]
quotes (x:xs) = x:quotes xs
sepByComma :: String -> [String]
sepByComma s = go s ""
where
go [] acc = [acc]
go (',':' ':xs) acc = [acc] ++ go xs ""
go (x:xs) acc = go xs (acc ++ [x])
parse :: String -> [String]
parse s = map quotes . sepByComma . brackets . plaster $ s
Here is an alternative using only the very basics, no Monads, Functors or Applicative operators.
main :: IO()
main = do
input <- getLine
let output = parse input
print output
parse :: String -> [String]
parse = map stripQuotes . parse' . tokenize []
where
parse' :: [String] -> [String]
-- If the input matches the pattern, call parseList on the inner tokens.
-- Does not nest brackets! This is a simple regex match.
parse' ("Plaster":"[":tokens) | last tokens == "]" =
parseList [] (removeLast tokens)
parse' _ = error "The input does not have the form \"Plaster [...]\"."
parseList :: [String] -> [String] -> [String]
-- Empty list.
parseList tokens [] = tokens
-- Unexpected tokens.
parseList _ (",":_) = error "Unexpected comma."
parseList _ ("[":_) = error "No support for nested brackets."
parseList _ ("]":_) = error "Unexpected input after \"]\"."
-- One-element list.
parseList tokens [x] = tokens ++ [x]
-- Comma-separated list with at least two elements.
parseList tokens (x:",":y:ys) = parseList (tokens ++ [x]) (y:ys)
-- Comma at end of list, so we don’t want to give the "expected comma" error!
parseList _ [_,","] = error "Extra comma at end of list."
-- More than one element not separated by commas.
parseList _ (x:_) = error $ "Expected comma after \"" ++ x ++ "\"."
stripQuotes :: String -> String
stripQuotes ('"':xs) | last xs == '"' = removeLast xs
stripQuotes xs = error $ "Expected string literal instead of " ++ xs ++ "."
removeLast :: [a] -> [a]
removeLast xs = take ((length xs) - 1) xs
whitespace :: [Char]
whitespace = [' ', '\n', '\t'] -- Incomplete, but sufficient.
isWhitespace :: Char -> Bool
isWhitespace c = elem c whitespace
tokenize :: [String] -> String -> [String]
-- If we’ve consumed all the input, we’re done.
tokenize tokens [] = tokens
-- We’d need something a little more complicated for longer operators:
tokenize tokens ('[':xs) = tokenize (tokens ++ ["["]) xs
tokenize tokens (']':xs) = tokenize (tokens ++ ["]"]) xs
tokenize tokens (',':xs) = tokenize (tokens ++ [","]) xs
-- Not currently processing a token, so skip whitespace.
-- Otherwise, start a new token.
tokenize tokens (x:xs) | isWhitespace x = tokenize tokens xs
| otherwise = tokenize' tokens [x] xs
where
tokenize' :: [String] -> String -> String -> [String]
-- If we’ve consumed all the input, the current token is the last.
tokenize' ts t [] = ts ++ [t]
-- If we encounter an operator, it is the token after the current one.
tokenize' ts t ('[':ys) = tokenize (ts ++ [t] ++ ["["]) ys
tokenize' ts t (']':ys) = tokenize (ts ++ [t] ++ ["]"]) ys
tokenize' ts t (',':ys) = tokenize (ts ++ [t] ++ [","]) ys
-- Whitespace means the current token is complete.
-- Otherwise, append y to the current token and continue.
tokenize' ts t (y:ys) | isWhitespace y = tokenize (ts ++ [t]) ys
| otherwise = tokenize' ts (t ++ [y]) ys
You wouldn’t do this in production code; this is simple enough to do with a regex, and parsing is (more or less) a solved problem. Parser combinators are the trendy way to go.
What is the best way to map across a list, using the result of each map as you go along, when your result is of a different type to the list.
for example
f :: Int -> Int -> String -> String
l = [1,2,3,4]
I would like to have something that walks along the list l and does:
f 1 2 [] = result1 => f 2 3 result1 = result2 => f 3 4 result3 ==> return result3.
I can sort of get this to work with a an accumulator, but it seems rather cumbersome. Is there a standard way to do this... or is this something for Monads??
Thanks!
NB the function above is just for illustration.
This is just a fold left over the pairs in the input list:
f :: Int -> Int -> String -> String
f = undefined
accum :: [Int] -> String
accum xs = foldl (flip . uncurry $ f) "" $ zip xs (drop 1 xs)
You probably want to use Data.List.foldl' instead of foldl, but this is an answer that works with just Prelude.
Seems like a job for fold:
func f l = foldl (\s (x, y) -> f x y s) "" (zip l (tail l))
-- just some placeholder function
f :: Int -> Int -> String -> String
f x y s = s ++ " " ++ show(x) ++ " " ++ show(y)
l = [1,2,3,4]
main = print $ func f l
prints:
" 1 2 2 3 3 4"
(if you can change the signature of f, you can get rid of the ugly lambda that rearranges arguments)
Of course, rather than zipping, you could pass along the previous element inside the fold's accumulator. For example:
l = [1,2,3,4]
f x y = (x,y)
g b#(accum,prev) a = (accum ++ [f prev a],a)
main = print (foldl g ([],head l) (tail l))
Output:
([(1,2),(2,3),(3,4)],4)
How I can make here filter (x:xs) = (x, length (x:xs)) that puts length when length > 1?
Currently, if input is abcaaabbb output is [('a',1),('b',1),('c',1),('a',3),('b',3)], but I'm looking for abca3b3.
My code:
import Data.List
encode :: [Char] -> [(Char, Int)]
encode s = map go (group s)
where go (x:xs) = (x, length (x:xs))
main = do
s <- getLine
print (encode s)
Last string will be putStrLn (concat (map (\(x,y) -> x : [y]) (encode s))) for convert list to string.
As I am a newbie myself, this is probably not very haskellian. But you can do it about like this (xs as would be the list [('a', 1), ('b', 2), ('a', 3)]):
Create "a1b2a3":
concat $ map (\(c, l) -> c:(show l)) xs
Filter out 1s:
filter (\x -> x /= '1') "a1b2a3"
will give you "ab2a3"
You can't have a list like this in Haskell:
[('a'),('b'),('c'),('a',3),('b',3)]
Each element if a list needs to have the same type in haskell, and ('c') [('a') :: Char] and ('b',3) [('a',1) :: Num t => (Char, t)] are different types.
Maybe also have a look at List of different types?
I would suggest, that you change your list to a (Char, Maybe num) datastructure.
Edit:
From your new question, I think you have been searching for this:
import Data.List
encode :: [Char] -> [(Char, Int)]
encode s = map go (group s)
where go (x:xs) = (x, length (x:xs))
f :: (Char, Int) -> String
f (a, b) = if b == 1 then [a] else [a] ++ show b
encode2 :: [(Char, Int)] -> String
encode2 [] = []
encode2 (x:xs) = f(x) ++ encode2 xs
main = do
s <- getLine
putStrLn $ encode2 $ encode s
Not sure if this suits your needs, but if you do not need filtering, this does the work:
encode::String -> String
encode "" = ""
encode (x:xs) = doIt0 xs x 1 where
doIt0 [] ch currentPos = [ch]++showPos currentPos
doIt0 (x:xs) ch currentPos
|x==ch = doIt0 xs ch $ currentPos+1
|otherwise= [ch]++ (showPos currentPos) ++ (doIt0 xs x 1)
showPos pos = if pos> 1 then show pos else ""
main = do
s <- getLine
print (encode s)
I have been learning some Haskell and I came up with a solution to one of my exercise which I was trying to figure out .
Changes a Char to another specified Char in a specified position in a String
changeStr :: Int -> Char -> String -> String
changeStr x char zs = (take (x-1) zs) ++ [(changeChar (head (take x zs)) char)] ++ (drop x zs)
Changes a Char to another Char
changeChar :: Char -> Char -> Char
changeChar x y = y
I just wanted to ask is there any other way in which I could do this in a more simpler way using different methods ?
The thing that screams for generalization is changeChar. It's actually very close to a very common Haskell Prelude function called const. To get changeChar we just need to flip const.
const :: a -> b -> a
const a b = a
changeChar :: Char -> Char -> Char
changeChar = flip const
-- = flip (\a _ -> a)
-- = \_ a -> a
-- _ a = a
Beyond that, your code is fairly reasonable, but can be cleaned up by using a function splitAt
splitAt :: Int -> [a] -> ([a], [a])
splitAt n xs = (take n xs, drop n xs)
changeChar x char xs =
let (before, _it:after) = splitAt (x - 1)
in before ++ (char:after)
which also highlights a slight problem with this definition in that if your index is too large it will throw a pattern matching failure. We could fix that by making the function return an unmodified string if we "fall off the end"
changeChar x char xs =
let (before, after) = splitAt (x - 1)
in case after of
[] -> []
(_:rest) -> char:rest
There's a general pattern here as well of applying a modifying function at a particular place in a list. Here's how we can extract that.
changeAt :: Int -> (a -> a) -> [a] -> [a]
changeAt n f xs =
let (before, after) = splitAt (n-1)
in case after of
[] -> []
(x:rest) -> (f x):rest
We can use this to iterate the notion
-- | Replaces an element in a list of lists treated as a matrix.
changeMatrix :: (Int, Int) -> a -> [[a]] -> [[a]]
changeMatrix (i, j) x = changeAt i (changeAt j (const x))
What you have is pretty much what you need, except the function changeChar is just flip const, and you could rewrite yours as
changeStr x char zs = take (x-1) zs ++ [char] ++ drop x zs
If you wanted to be complicated, you could use splitAt from Data.List and the fact that fmap f (a, b) = (a, f b)
changeStr idx c str = uncurry (++) $ fmap ((c:) . tail) $ splitAt (idx - 1) str
And if you wanted to be really complicated, you could ask the pointfree bot how to write it without explicit function arguments
changeStr = ((uncurry (++) .) .) . flip ((.) . fmap . (. tail) . (:)) . splitAt . subtract 1
I want to filter a string with a string.
What I want is to use delete every first occurring char.
myFunc :: String -> String -> String
Like:
myFunc "dddog" "bigdddddog" = "biddg"
In "dddog": 3x d, 1x o, 1x g
In the second string it removed 3x d, 1x o and 1x g
So the output: biddg
I can't use filter for it, because it will delete all occurring chars.
And I struggled a long time with it.
Thanks in advance:)
How about
Prelude> :m +Data.List
Prelude Data.List> "bigdddddog" \\ "dddog"
"biddg"
Not the nicest solution, but you can understand easier what's going on:
myfunc :: String -> String -> String
myfunc [] xs = xs
myfunc (x:xs) ys = myfunc xs $ remove x ys
where
remove _ [] = []
remove x (y:ys) = if x == y then ys else y : remove x ys
As you commented, you want to use guards. Do you mean this?
myfunc :: String -> String -> String
myfunc [] xs = xs
myfunc (x:xs) ys = myfunc xs $ remove x ys
remove :: Char -> String -> String
remove _ [] = []
remove x (y:ys)
| x == y = ys
| otherwise = y : remove x ys
some of the other solutions don't seem to produce the same result you posted. I think I have a simple solution that does what you asked for but I may be misunderstanding what you want. All I do in the following code is go though the list and apply 'delete' to every element in the list. It's not exactly efficient but it gets the job done.
import Data.List
myFunc (x:xs) ys = myFunc xs (delete x ys)
myFunc [] ys = ys
There are perhaps more efficient solutions like storing the "to remove" list in a tree with the number of occurences stored as the value then traversing the main list testing to see if the count at that key was still greater than zero. I think that would give you O(n*lg(m)) (where n is the size of the list to be removed from and m is the size of the "to remove" list) rather than O(n*m) as is the case above. This version could also be maid to be lazy I think.
edit:
Here is the tree version I was talking abut using Data.Map. It's a bit complex but should be more efficient for large lists and it is somewhat lazy
myFunc l ys = myFunc' (makeCount l) ys
where makeCount xs = foldr increment (Map.fromList []) xs
increment x a = Map.insertWith (+) x 1 a
decrement x a = Map.insertWith (flip (-)) x 1 a
getCount x a = case Map.lookup x a of
Just c -> c
Nothing -> 0
myFunc' counts (x:xs) = if (getCount x counts) > 0
then myFunc' (decrement x counts) xs
else x : myFunc' counts xs
myFunc' _ [] = []
I am not quite sure about how you want your function to behave, how about this?
import Data.List (isPrefixOf)
myFunc :: String -> String -> String
myFunc _ [] = []
myFunc y x'#(x:xs) | y `isPrefixOf` x' = drop (length y) x'
| otherwise = x : myFilter xs y
This gives the following output in GHCi:
> myFunc "dddog" "bigdddddog"
> "bigdd"
If this is not what you had in mind, please give another input/output example.
I like kaan's elegant solution. In case you meant this...here's one where the "ddd" would only be removed if matched as a whole:
import Data.List (group,isPrefixOf,delete)
f needles str = g (group needles) str where
g needles [] = []
g needles xxs#(x:xs)
| null needle' = [x] ++ g needles xs
| otherwise = let needle = head needle'
in g (delete needle needles) (drop (length needle) xxs)
where needle' = dropWhile (not . flip isPrefixOf xxs) needles
Output:
*Main> f "dddog" "bigdddddog"
"biddg"
*Main> f "dddog" "bdigdogd"
"bdidgd"
No monadic solution yet, there you go:
import Control.Monad.State
myFunc :: String -> State String String
myFunc [] = return ""
myFunc (x:xs) = get >>= f where
f [] = return (x:xs)
f (y:ys) = if y == x then put ys >> myFunc xs
else myFunc xs >>= return . (x:)
main = do
let (a,b) = runState (myFunc "bigdddddog") "dddog" in
putStr a
Using predefined functions from Data.List,
-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
-- lookup :: (Eq a) => a -> [(a, b)] -> Maybe b
{-# LANGUAGE PatternGuards #-}
import Data.List
picks [] = [] -- http://stackoverflow.com/a/9889702/849891
picks (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- picks xs]
myFunc a b = concat . snd $ mapAccumL f (picks a) b
where
f acc x | Just r <- lookup x acc = (picks r,[])
f acc x = (acc,[x])
Testing:
Prelude Data.List> myFunc "dddog" "bigdddddog"
"biddg"
edit: this is of course a bit more complex than (\\). I'll let it stand as an illustration. There could be some merit to it still, as it doesn't copy the 2nd (longer?) string over and over, for each non-matching character from the 1st (shorter) string, as delete apparently does, used in (\\) = foldl (flip delete).