I'm really new in Haskell. perhaps this is a simple question for the master coder. I want to remove the quotation mark outside the string. such as "A1" to A1.
I tried my best to solve this problem. but it doesn't work. I already used read :: Read a => String -> a, id function, and regular expression.
initialGuess :: ([Pitch],GameState)
initialGuess = (startGuess, GameState (chords))
where startGuess = ["A1", "B1", "C1"]
standard = [[n, o] | n <- ['A'..'G'], o <- ['1'..'3']] <br/>
chords = [[a,b,c] | a <- standard, b <- standard, c <-
standard, a /= b, b /= c, a /= c]
initialGuess aim to takes no input arguments.And returns a pair of an initial guess and a game state. Running this code I can get
["A1","B1","C1"],GameState [["A1","A2","A3"],["A1","A2","B1"],["A1","A2","B2"],["A1","A2","B3"],["A1","A2","C1"]................["A1","A2","C2"],["A1","A2","C3"],["A1","A2","D1"],["A1","A2","D2"],["A1","A2","D3"]]
however, I want to remove these quotation marks such as
[A1,B1,C1],GameState [[A1,A2,A3],[A1,A2,B1],[A1,A2,B2],[A1,A2,B3],[A1,A2,C1]................[A1,A2,C2],[A1,A2,C3],[A1,A2,D1],[A1,A2,D2],[A1,A2,D3]]
If all you are trying to do is make the states prettier, you can provide your own display function:
-- |Display a list of strings without quotation marks
showLStr :: [String] -> String
showLStr p = "[" ++ intercalate "," p ++ "]"
The intercalate function puts the "," between each element of the list of strings.
showLStr ["A1", "A2", "A3"]
should display as
[A1,A2,A3]
Edit: Now you can use showLStr to display the game state:
showGameState :: GameState -> String
showGameState (GameState chords) =
"GameState [" ++ (intercalate "," $ map showLStr chords) ++ "]"
-- |Make GameState "Show"-able
instance Show GameState where
show = showGameState
showGuess :: ([Pitch],GameState) -> String
showGuess (pitch, gameState) = showLStr pitch ++ ", " ++ show gameState
Related
I am making a program that replaces stuff using the Esperanto X-System to Esperanto, so I need it to transform "cx" to "ĉ", "sx" to "ŝ", "gx" to "g", "jx" to "ĵ", and "ux" to "ŭ", and the same for uppercase letters.
Currently it converts "a" to "b", and "c" to "d". The method I am currently using will only work for replacing single character, not multiple characters. So how do I replace multiple characters (like "cx") instead of a single one (like "a")?
replaceChar :: Char -> Char
replaceChar char = case char of
'a' -> 'b'
'c' -> 'd'
_ -> char
xSistemo :: String -> String
xSistemo = map replaceChar
So currently "cats" will transform to "dbts".
As #AJFarmar pointed out, you are probably implementing Esperanto's X-system [wiki]. Here all items that are translated are digraphs that end with x, the x is not used in esperato itself. We can for example use explicit recursion for this:
xSistemo :: String -> String
xSistemo (x:'x':xs) = replaceChar x : xSistemo xs
xSistemo (x:xs) = x : xSistemo xs
xSistemo [] = []
where we have a function replaceChar :: Char -> Char, like:
replaceChar :: Char -> Char
replaceChar 's' = 'ŝ'
-- ...
This then yields:
Prelude> xSistemo "sxi"
"\349i"
Prelude> putStrLn (xSistemo "sxi")
ŝi
A generic method:
The problem looks similar to question 48571481.
So you could try to leverage the power of Haskell regular expressions.
Borrowing from question 48571481, you can use foldl to loop thru the various partial substitutions.
This code seems to work:
-- for stackoverflow question 57548358
-- about Esperanto diacritical characters
import qualified Text.Regex as R
esperantize :: [(String,String)] -> String -> String
esperantize substList st =
let substRegex = R.subRegex
replaceAllIn = foldl (\acc (k, v) -> substRegex (R.mkRegex k) acc v)
in
replaceAllIn st substList
esperSubstList1 = [("cx","ĉ"), ("sx","ŝ"), ("jx","ĵ"), ("ux","ŭ")]
esperantize1 :: String -> String
esperantize1 = esperantize esperSubstList1 -- just bind first argument
main = do
let sta = "abcxrsxdfuxoojxii"
putStrLn $ "st.a = " ++ sta
let ste = esperantize1 sta
putStrLn $ "st.e = " ++ ste
Program output:
st.a = abcxrsxdfuxoojxii
st.e = abĉrŝdfŭooĵii
We can shorten the code, and also optimize it a little bit by keeping the Regex objects around, like this:
import qualified Text.Regex as R
esperSubstList1_raw = [("cx","ĉ"), ("sx","ŝ"), ("jx","ĵ"), ("ux","ŭ")]
-- try to "compile" the substitution list into regex things as far as possible:
esperSubstList1 = map (\(sa, se) -> (R.mkRegex sa, se)) esperSubstList1_raw
-- use 'flip' as we want the input string to be the rightmost argument for
-- currying purposes:
applySubstitutionList :: [(R.Regex,String)] -> String -> String
applySubstitutionList = flip $ foldl (\acc (re, v) -> R.subRegex re acc v)
esperantize1 :: String -> String
esperantize1 = applySubstitutionList esperSubstList1 -- just bind first argument
main = do
let sta = "abcxrsxdfuxoojxiicxtt"
putStrLn $ "st.a = " ++ sta
let ste = esperantize1 sta
putStrLn $ "st.e = " ++ ste
I have been trying to to iterate the cand data in order to apply a function "pt_string".
Pt :: (Float, Float)
Person :: (Pt, Pt, [Pt], Float)
My idea is to call that function "pt_string" in a different way for each element of the tupple.
For example:
pt_string Point (first)
map pt_string [Point]
pt_string Point (second)
show "Tmp"
So far, I got:
pt_string :: pt -> String
pt_string pt = "(" ++ show (fst pt) ++ "," ++ show (snd pt) ++ ")\n"
Which works fine. But how can I create cand_to_string :: cand -> String in the above order?
Thanks!
Assuming
type Candidate = (Point, Point, [Point], Float)
you can use
candidate_to_string :: Candidate -> String
candidate_to_string (p1, p2, ps, f) =
"(" ++
point_to_string p1 ++ ", " ++
point_to_string p2 ++ ", " ++
points_to_string ps ++ ", " ++
show f ++
")"
which relies on
points_to_string :: [Point] -> String
points_to_string ps = "[" ++ intercalate ", " (map point_to_string ps) ++ "]"
exploiting Data.List.intercalate to add commas between the points.
Also note that, if you simply want the standard list/tuple printing format, you can directly use
candidate_to_string :: Candidate -> String
candidate_to_string = show
I want to know how to make modifications to a text that is full of special characters and codes and replace those codes with strings.
I have the following text:
text=
"#chomsky/syntactic structures/chomskySynt/: published in 1957. #bloomfield/language/bloomfieldLan/: published in 1933. #chomsky/aspects of a theory of syntax/chomskyAsp/: published in 1965. ... #see/chomskySynt/ is considered the starting point of generative linguistics.... Another hypothesis was introduced in #see/chomskyAsp/."
I want to turn it into=
"Chomsky 1: Syntactic structures : published in 1957. Bloomfield 1: Language : published in 1933. Chomsky 2: Aspects of a theory of syntax : published in 1965. ... Chomsky 1 is considered the starting point of generative linguistics ... Another hypothesis was introduced in Chomsky 2..."
Explanation of the special characters and codes: the information on a book starts with # followed by the name of the author (chomsky for example) followed by / then title of the book / then the special code for the book (chomskyAsp) then /
The citation of a book starts with #see followed by / then the special code of the book (ex. chomskySyn) /
The modifications are:
To count how many times an author is cited and concatenate the number to the name: Chomsky 1, for example.
Author name will start with a capital letter
Remove the special code : chomskySynt which serves only as an identification code.
Replace the reference : #see/chomskyAsp with the Chomsky 2. That is replace the reference with the actual author and number.
Here is my code:
RemoveSlash = myReplace "/"" " text
removeDash = map lines $ (filter(any isLetter) . groupBy ( (==) `on` (=='#'))) $ removeSlash
flattenList= concat removeDash
splitIntoWords = map words flattenList
And here is the myReplace function:
myReplace _ _ [] = []
myReplace a b s#(x:xs)= if isPrefixOf a s
then b++myReplace a b (drop(length a)s)
else x: myReplace a b xs
Here is the result so far:
[["chomsky syntactic structures chomskySynt published in 1957. "], ["bloomfield language bloomfieldLan published in 1933. "],["chomsky aspects of a theory of syntax chomskyAsp published in 1965. ... "],["see chomskySynt is considered the starting point of generative linguistics.... Another hypothesis was introduced in "],["see chomskyAsp"]]
The reason I flattened the list and split it into words is now if I do:
map head splitIntoWords
I get ["chomsky","bloomfield","chomsky","see","see"]
I am stuck at this stage. How do I count how many times an author is cited and concatenate the number to the name. I thought of using the zip function:
zipChomsky =zip [1, 2][x | x <- diviser,(head x) == "chomsky"]
This gives:
[(1["chomsky","syntactic","structures","chomskySynt","published","in","1957."]),(2,["chomsky","aspects","of","a","theory","of","syntax","chomskyAsp","published","in","1965.","..."])]
But the result is very different from: Chomsky 1: ...
EDIT: I didn't mean to make the answer this long, but the problem turned out a non-trivial task, and I'm not quite sure how much detail I should put in the answer. In case you understand all the tools I'm using, the full code is just at the end of this answer.
In your case, you'll need:
an approach to parse your input document
a suitable data structure to store the input information
displaying the data as output format
For the parsing part, perhaps Regex is enough (maybe), but I guess the Parsec library is a better choice. For detailed usage of Parsec please refer to the link, and I'll only try to show how to use it in your case:
First, import Text.ParserCombinators.Parsec.
A document is a list of
a literal string
a definition, with format #<Author>/<Title>/<Code>/, as in "#chomsky/syntactic structures/chomskySynt/"
a citation, with format #see/<Code>/, as in "#see/chomskyAsp/"
Hence we define
data Index = Index {
getAuthor :: String,
getTitle :: String,
getSpecialCode :: String,
getAuthorCount :: Int
-- For counting author later.
} deriving (Show)
data Content = Def Index
| Cite String Index
-- We'll fill in Index later.
| Literal String
deriving (Show)
and our input document will just be turned into [Content].
Correspondingly, we'll use the following function (actually, parser) to parse the input:
document = many (try def <|> try cite <|> literal)
literal = Literal <$> many1 (noneOf "#")
def = do
char '#'
author <- many1 $ noneOf "/"
char '/'
title <- many1 $ noneOf "/"
char '/'
code <- many1 $ noneOf "/"
char '/'
return $ Def author title code
cite = do
try $ string "#see/"
code <- many1 $ noneOf "/"
char '/'
return $ Cite code nullIndex
A short explanation:
A document is many (def or cite or literal), with operator <|> combining parsers.
A literal is a string, stopping at '#', with at least 1 char (using many1); a parser inside many should not accept empty input, think of why!
A def is #<Author>/<Title>/<Code>/, and we can write in do-notation since Parser is a monad.
A cite goes similarly.
A def, cite, or string "#see/" parse multiple characters, hence is possible to fail when they have consumed some chars; therefore, we use the combinator try.
By the way, nullIndex is just a placeholder before we actually fill this record:
nullIndex :: Index
nullIndex = Index "" "" "" 0
Now we only need a function with signiture [Content] -> String.
We can start with captializing the author name:
capitalizeAuthor :: Content -> Content
capitalizeAuthor (Def x) = Def (x {getAuthor = author'}) where
author' = toUpper (head author) : tail author
author = getAuthor x
capitalizeAuthor y = y
The other tasks are not local, since the relation between Contents should be observed, hence we will use a foldl across the list.
Define
import Data.Map.Strict ((!))
import qualified Data.Map.Strict as M
type CodeDict = M.Map String Index
-- Map Code Index
type AuthorDict = M.Map String Int
-- Map Author Count
type Fold = (CodeDict, AuthorDict, [Content])
emptyFold :: Fold
emptyFold = (M.empty, M.empty, [])
The Fold type will store the state when we modify along the original [Content].
(I realize that the code will be much clearer if I use the State monad, but I'm not sure if I need to explain it then ...)
In addition, a folding function for foldl
accum :: Fold -> Content -> Fold
accum (c,a,ls) (Def x) = (c',a',Def x':ls) where
a' = M.insertWith (+) author 1 a
c' = M.insert code x' c
x' = x {getAuthorCount = count}
count = maybe 1 (+1) $ a !? author
author = getAuthor x
code = getSpecialCode x
accum (c,a,ls) (Cite code _) = (c,a,Cite code (c ! code) : ls)
accum (c,a,ls) y = (c,a,y:ls)
After foldr, the resulted list will contain the contents with
getAuthorCount correctly filled
Cites transferred into Defs, since they have the same outputting format.
The resulted list is reversed, so you'll need Data.List.reverse.
Finally, you can define your own version of Show for Content. For example,
instance Show Index where
show x = getAuthor x ++ " "
++ show (getAuthorCount x) ++ ": "
++ getTitle x ++ " "
instance Show Content where
show (Def idx) = show idx
show (Cite x idx) = getAuthor idx ++ " "
++ show (getAuthorCount idx)
show (Literal x) = x
as I figured out from your output sample.
The full length code:
import Data.Char
import Data.List (reverse)
import Data.Map.Strict ((!),(!?))
import qualified Data.Map.Strict as M
import Text.ParserCombinators.Parsec
data Index = Index {
getAuthor :: String,
getTitle :: String,
getSpecialCode :: String,
getAuthorCount :: Int
-- For counting author later.
}
nullIndex :: Index
nullIndex = Index "" "" "" 0
instance Show Index where
show x = getAuthor x ++ " "
++ show (getAuthorCount x) ++ ": "
++ getTitle x ++ " "
data Content = Def Index
| Cite String Index
| Literal String
instance Show Content where
show (Def idx) = show idx
show (Cite x idx) = getAuthor idx ++ " "
++ show (getAuthorCount idx)
show (Literal x) = x
document = many (try cite <|> try def <|> literal)
literal = Literal <$> many1 (noneOf "#")
def = do
char '#'
author <- many1 $ noneOf "/"
char '/'
title <- many1 $ noneOf "/"
char '/'
code <- many1 $ noneOf "/"
char '/'
return $ Def $ Index author title code 0
cite = do
try $ string "#see/"
code <- many1 $ noneOf "/"
char '/'
return $ Cite code nullIndex
capitalizeAuthor :: Content -> Content
capitalizeAuthor (Def x) = Def (x {getAuthor = author'}) where
author' = toUpper (head author) : tail author
author = getAuthor x
capitalizeAuthor y = y
type CodeDict = M.Map String Index
-- Map Code Index
type AuthorDict = M.Map String Int
-- Map Author Count
type Fold = (CodeDict, AuthorDict, [Content])
emptyFold :: Fold
emptyFold = (M.empty, M.empty, [])
accum :: Fold -> Content -> Fold
accum (c,a,ls) (Def x) = (c',a',Def x':ls) where
a' = M.insertWith (+) author 1 a
c' = M.insert code x' c
x' = x {getAuthorCount = count}
count = maybe 1 (+1) $ a !? author
author = getAuthor x
code = getSpecialCode x
accum (c,a,ls) (Cite code _) = (c,a,Cite code (c ! code) : ls)
accum (c,a,ls) y = (c,a,y:ls)
main :: IO ()
main = do
line <- getLine
let parsed = parse document "" line
case parsed of
Left x -> print x
Right cs -> do
let cs1 = map capitalizeAuthor cs
let (_,_,cs2) = foldl accum emptyFold cs1
let output = concatMap show $ reverse cs2
putStrLn output
I have the following functions in Haskell that must print the sales of weeks. Each sale in a new line. But it is not working the way i expect it to. The problem i have is the newline character '\n'.
Code:
printWeeks :: Int->String
printWeeks 0 = printWeek 0
printWeeks x = printWeeks(x-1) ++ printWeek x
printWeek :: Int->String
printWeek x = show(x) ++ " " ++ stars (sales x) ++ "'\n'"
I have tried many ways but the new line character is not working as expected. Everything is printed on the same line whichis not what i want.
Need help?
thanks
UPDATE
The following is not working because of compile errors. The errors comes from the second line of formatLines. The type decalaration is causing errors. Need help here
formatLine :: (Name,Price)->IO()
formatLine (a,b) = putStrLn (a ++ dots ++ p)
where
x=(length a)
p=(formatPence b)
y=length p
z=lineLength-(x+y)
dots = printDots z
formatLines :: [(Name,Price)]->IO()
formatLines []= ""
formatLines (a:x) = formatLines x ++ formatLine a
You should use ++ "\n" to append a newline to the output; your current code will add a ', then a newline, then another '.
As #marcog points out, be sure to use putStr to print it out (or don't append the newline at all and use putStrLn). Example:
Hugs> putStr (show 4 ++ "\n")
4
Hugs> putStrLn (show 4 ++ "\n")
4
Hugs> print (show 4 ++ "\n")
"4\n"
(Note that the Hugs interpreter adds extra newlines after each output.)
You are probably printing the string using print x, which is equivalent to putStrLn (show x). show x is converting the newlines into readable characters \ and n. You need to use putStrLn x instead, or putStr x if you don't want to append a newline to the end of the string.
You should also remove the single quotes you have around the newline, unless that was intentional.
It's a bit of a riddle why so much action is happening under the heading of IO. This is maybe a little verbose. I couldn't tell where lineLength was coming from so I made it a parameter.
formatLine :: Int -> (Name,Price) -> String
formatLine linelength (name, price) = name ++ dotfill ++ showprice
where
showprice :: String
showprice = formatPence price
extra :: Int
extra = linelength - length (name ++ showprice)
dotfill :: String
dotfill = replicate extra '.'
formatLines :: Int -> [(Name, Price)] -> String
formatLines linelength []= ""
formatLines linelength (first:rest) =
(formatLine linelength first ++ "\n") ++ formatLines linelength rest
standardPrint :: [(Name, Price)] -> IO ()
standardPrint listing = putStrLn (formatLines 50 listing)
fileAwayPrices :: FilePath -> [(Name,Price)] -> IO()
fileAwayPrices filename listing = writeFile filename (formatLines 70 listing)
testlist :: [(Name,Price)]
testlist = [("oats",344),("barley", 299),("quinoa",599)]
-- *Main> standardPrint testlist
-- oats...........................................344
-- barley.........................................299
-- quinoa.........................................599
type Name = String
type Price = Integer
formatPence n = show n
Re your update: your type declaration is correct, it's the rest of formatLines that's wrong.
formatLines :: [(Name,Price)]->IO()
formatLines [] = return ()
formatLines (a:x) = formatLines x >> formatLine a
A more concise way of writing that is
formatLines :: [(Name,Price)]->IO()
formatLines = mapM_ formatLine . reverse
This function generates simple .dot files for visualizing automata transition functions using Graphviz. It's primary purpose is debugging large sets of automatically generated transitions (e.g., the inflections of Latin verbs).
prepGraph :: ( ... ) => NFA c b a -> [String]
prepGraph nfa = "digraph finite_state_machine {"
: wrapSp "rankdir = LR"
: wrapSp ("node [shape = circle]" ++ (mapSp (states nfa \\ terminal nfa)))
: wrapSp ("node [shape = doublecircle]" ++ (mapSp $ terminal nfa))
: formatGraph nfa ++ ["}"]
formatGraph :: ( ... ) => NFA c b a -> [String]
formatGraph = map formatDelta . deltaTuples
where formatDelta (a, a', bc) = wrapSp (mkArrow a a' ++ " " ++ mkLabel bc)
mkArrow x y = show x ++ " -> " ++ show y
mkLabel (y, z) = case z of
(Just t) -> "[ label = \"(" ++ show y ++ ", " ++ show t ++ ")\" ]"
Nothing -> "[ label = \"(" ++ show y ++ ", " ++ "Null" ++ ")\" ]"
where wrap, wrapSp and mapSp are formatting functions, as is deltaTuples.
The problem is that formatGraph retains double quotes around Strings, which causes errors in Graphviz. E.g., when I print unlines $ prepGraph to a file, I get things like:
0 -> 1 [ label = "('a', "N. SF")" ];
instead of
0 -> 1 [ label = "('a', N. SF)" ];
(However, "Null" seems to work fine, and outputs perfectly well). Now of course the string "N. SF" isn't the actual form I use to store inflections, but that form does include a String or two. So how can I tell Haskell: when you show a String values, don't double-quote it?
Check out how Martin Erwig handled the same problem in Data.Graph.Inductive.Graphviz:
http://hackage.haskell.org/packages/archive/fgl/5.4.2.3/doc/html/src/Data-Graph-Inductive-Graphviz.html
The function you're looking for is "sq" at the bottom:
sq :: String -> String
sq s#[c] = s
sq ('"':s) | last s == '"' = init s
| otherwise = s
sq ('\'':s) | last s == '\'' = init s
| otherwise = s
sq s = s
(check out the context and adapt for your own code, of course)
Use dotgen package - it has special safeguards in place to prevent forbidden chars from sneaking into attribute values.
You could define your own typeClass like this:
class GShow a where
gShow :: a -> String
gShow = show
instance GShow String where
show = id
instance GShow Integer
instance GShow Char
-- And so on for all the types you need.
The default implementation for "gShow" is "show", so you don't need a "where" clause for every instance. But you do need all the instances, which is a bit of a drag.
Alternatively you could use overlapping instances. I think (although I haven't tried it) that this will let you replace the list of instances using the default "gShow" by a single line:
instance (Show a) => GShow a
The idea is that with overlapping instances the compiler will chose the most specific instance available. So for strings it will pick the string instance over the more general one, and for everything else the general one is the only one that matches.
It seems a little ugly, but you could apply a filter to show t
filter (/='"') (show t)