I am a complete beginner at haskell and as such, I have a hard time debugging since it's so different from imperative languages. When I try to run this code, I get an infinite list of Int and I have no idea of why it's infinite. Now I know the code is probably very ugly and in no way efficient, but my goal is just to make it work, not make it work efficiently.
chaineVersSon :: String -> Int -> [Int]
chaineVersSon chaineAInterpreter battementParMinute = integriser (concat
(musicaliser (freqNotes (interpreter 9 4 1 5 chaineAInterpreter []))
battementParMinute))
integriser :: [Double] -> [Int]
integriser [] = []
integriser (note:notes) = (floor (note * 32767)):integriser notes
musicaliser :: [(Double, (Double, Double))] -> Int -> [[Double]]
musicaliser [] _ = []
musicaliser (note:notes) tempo = (creerSon note tempo 0):musicaliser notes tempo
creerSon :: (Double, (Double, Double)) -> Int -> Double -> [Double]
creerSon note tempo temps
| temps < (calcDuree note tempo temps) = (echantillonner note
temps):creerSon note tempo (temps + (1/(fromIntegral frequenceEchantillonage)))
| temps == (calcDuree note tempo temps) = (echantillonner note temps):[]
calcDuree :: (Double, (Double, Double)) -> Int -> Double -> Double
calcDuree note tempo temps = (60 * (fst(snd note)) / (fromIntegral tempo)) /
(1/(fromIntegral frequenceEchantillonage)) + temps
echantillonner :: (Double, (Double, Double)) -> Double -> Double
echantillonner note temps = ((snd (snd note)) / 10) * sin(2 * pi * (fst note) * temps)
--Fonction qui traite toutes les modifications d'état
interpreter :: Int -> Int -> Double -> Double -> String -> [((Int, Int),
(Double, Double))] -> [((Int, Int), (Double, Double))]
interpreter _ _ _ _ [] _ = []
interpreter note octave duree volume (etat:chaine) pile
| etat == '0' = interpreter note octave duree 0 chaine pile
| etat == '.' = interpreter note octave (duree*1.5) volume chaine pile
| etat == '/' = interpreter note octave (duree/2) volume chaine pile
| etat == '[' = interpreter note octave duree volume chaine (((note, octave), (duree, volume)):pile)
| etat == ']' = interpreter (fst (fst save)) (snd (fst save)) (fst (snd save)) (snd (snd save)) chaine pile
| etat >= 'a' && etat <= 'g' = interpreter (changerNote etat) octave duree volume chaine pile
| etat >= '2' && etat <= '9' = interpreter note (read [etat]) duree volume chaine pile
| etat == '&' = interpreter (fst (diminuer note octave)) (snd (diminuer note octave)) duree volume chaine pile
| etat == '&' = interpreter (fst (augmenter note octave)) (snd (augmenter note octave)) duree volume chaine pile
| etat == '!' = ((note, octave), (duree, volume)):(interpreter note octave duree volume chaine pile)
| otherwise = interpreter note octave duree volume chaine pile
where save = head pile
--Fonction pour changer la note selon l'option fournie
changerNote :: Char -> Int
changerNote etat
| etat == 'a' = 9
| etat == 'b' = 11
| etat == 'c' = 0
| etat == 'd' = 2
| etat == 'e' = 4
| etat == 'f' = 5
| etat == 'g' = 7
--Fonction qui diminue la note et l'octave si possible/nécéssaire
diminuer :: Int -> Int -> (Int, Int)
diminuer note octave
| note > 0 = (note - 1, octave)
| note == 0 && octave == 2 = (note, octave)
| otherwise = (11, octave - 1)
--Fonction qui augmente la note et l'octave si possible/nécéssaire
augmenter :: Int -> Int -> (Int, Int)
augmenter note octave
| note < 11 = (note + 1, octave)
| note == 11 && octave == 9 = (note, octave)
| otherwise = (0, octave + 1)
--Fonction récursive pour calculer la fréquence de chaque note à jouer
freqNotes :: [((Int, Int), (Double, Double))] -> [(Double, (Double, Double))]
freqNotes [] = []
freqNotes (note:notes) = ((calcFrequence (fromIntegral (fst (fst note))) (fromIntegral (snd (fst note)))), (fst (snd note), snd (snd note))):freqNotes notes
--Fonction qui calcule la fréquence selon la note et l'octave
calcFrequence :: Double -> Double -> Double
calcFrequence note octave = 440 * (2**(1/12))**((12 * octave) + note - 57)
main::IO()
main = do argv <- getArgs
chaine <- readFile ( argv !! 0 )
print "Begin..."
print ( chaineVersSon chaine ( ( read ( argv !! 1 ) ) :: Int ) )
print "Done!"
Normally in other languages I would just print things everywhere and see where the results get wrong but I don't know how to do that in Haskell without rewriting almost the entire code. What kind of method should I use to find where my code goes wrong?
I've read about trace, but I can't seem to be able to actually print anything with it.
If your list is infinite, that means creerSon always goes to the first case, which means temps is always smaller than calcDuree note tempo temps, which is because calcDuree has + temps at the end.
I noticed this by refactoring away at your code, making it shorter using library functions such as map, until I could read it.
You could have noticed this by running a code coverage tool such as stack test --coverage on your program to see what code ever gets reached.
Related
I want to create game Magic 15 Puzzle in Haskell I have function set :: [[Char]] -> Char -> [[Char]] .
It switches Char with empty space in [[Char]].
*Main> pp puzzle2
AC DE
FBHIJ
KGLNO
PQMRS
UVWXT
*Main> pp (set puzzle2 'C')
A CDE
FBHIJ
KGLNO
PQMRS
UVWXT
*Main>
Now I want to do recursion for [Char] (or String) like this (To do set xs for previous set x)
puzzle :: Result -> [Char] -> Result
puzzle gameboard (x:xs) = set (set (x:xs) x) xs
But compilation says it is error:
Couldn't match expected type ‘Char’ with actual type ‘[Char]’
I expect this output:
*Main> pp(puzzle puzzle2 "CB")
ABCDE
F HIJ
KGLNO
PQMRS
UVWXT
What can I do to solve this? Thanks a lot in advance for answer!
Whole Code:
import Data.Char
type Result = [String]
pp :: Result -> IO ()
pp x = putStr (concat (map (++"\n") x))
puzzle2 :: [[Char]]
puzzle2 = ["AC DE",
"FBHIJ",
"KGLNO",
"PQMRS",
"UVWXT"]
getCords board x = head ( head [[(row_index, column_index) |(column_index, char) <- zip[1..] row, x == char] |(row_index,row)<- zip [1..]board,x `elem` row])
getRow board c = fst ( getCords board c)
getCol board c = snd ( getCords board c)
check ch1 ch2 board = (getRow board ch2 == getRow board ch1 + 1 || getRow board ch2 == getRow board ch1 - 1) && (getCol board ch1 == getCol board ch2) || ((getRow board ch1 == getRow board ch2) && (getCol board ch2 == getCol board ch1 + 1 || getCol board ch2 == getCol board ch1 - 1) )
set gameboard x | check x ' ' gameboard = [[if ch == ' ' then x else if ch == x then ' ' else ch | ch<- line] | line<-gameboard]
| not (check x ' ' gameboard ) = [[ch | ch<- line] | line<-gameboard]
puzzle :: Result -> [Char] -> Result
puzzle gameboard (x:xs) = set (set (x:xs) x) xs
Just change the last function to
puzzle :: Result -> [Char] -> Result
puzzle g [] = g
puzzle g (x:xs) = puzzle (set g x) xs
So im doing this function and i need her to display on the screen the result of (premio ap x) , the problem is that (premio ap x)::Maybe Int , so its not a string.
joga :: Aposta -> IO ()
joga x= do
ap <- leAposta;
let arroz = (premio ap x)
putStr ^^^^^^^^^^
return ()
How can i convert this to a string? Or there is another way to display on the screen things that are not strings.
update :full code
comuns :: Aposta -> Aposta -> (Int,Int)
comuns (Ap a (b,c)) (Ap k (l,ç)) = (cnum a k, cnum [b,c] [l,ç])
cnum::[Int]->[Int]->Int
cnum [] l2 = 0
cnum (x:xs) l2 | elem x l2 = 1 + cnum xs l2
|otherwise = cnum xs l2
premio :: Aposta -> Aposta -> Maybe Int
premio l1 l2 | x == (5,2)= Just 1
| x == (5,1)= Just 2
| x == (5,0)= Just 3
| x == (4,2)= Just 4
| x == (4,1)= Just 5
| x == (4,0)= Just 6
| x == (3,2)= Just 7
| x == (2,2)= Just 8
| x == (3,1)= Just 9
| x == (3,0)= Just 10
| x == (1,2)= Just 11
| x == (2,1)= Just 12
| x == (2,0)= Just 13
|otherwise = Nothing
where
x = comuns l1 l2
leAposta :: IO Aposta
leAposta = do
putStrLn "Insira como lista as 5 estrelas"
num <-getLine
putStrLn "Insira em par as 2 estrelas"
es<-getLine
let ap = (Ap (read num) (read es))
if (valida ap)
then return ap
else do
putStrLn "Aposta invalida"
leAposta
Since arroz is premio ap x which has type Maybe Int, you can simply print arroz.
print works on any type that can be printed, i.e. on those types in class Show.
(You probably don't want to use print on values that are already strings, though, since that will print the escaped string, with quotes around. Use putStr and putStrLn for strings.)
The following code with any real-logic "hollowed out" still runs out of memory when compiled on GHC 7.10.3 with the -O flag. I do not understand why a simple tree recursion with at-most a stack-depth of 52 (number of cards in a standard deck) needs so much memory. I tried using seq on the result variables, but that did not help. Could someone take a look and let me know why the memory usage is so high, and what can I do to avoid it?
import qualified Data.Map.Strict as M
type Card = (Int, Char)
compute_rank_multiplicity_map :: [Card] -> M.Map Int Int
compute_rank_multiplicity_map cards = M.fromList [(x, x) | (x, _) <- cards]
determine_hand :: [Card] -> (Int, [(Int, Int)])
determine_hand [] = error "Card list is empty!"
determine_hand cards = (0, mult_rank_desc_list)
where rank_mult_map = compute_rank_multiplicity_map cards
mult_rank_desc_list = M.toDescList rank_mult_map
check_kicker_logic :: [Card] -> (Int, Int)
check_kicker_logic cards =
let first_cards = take 5 cards
second_cards = drop 5 cards
first_hand#(f_h, f_mrdl) = determine_hand first_cards
second_hand#(s_h, s_mrdl) = determine_hand second_cards
in if (first_hand > second_hand) || (first_hand < second_hand) -- is there a clear winner?
then if (f_h == s_h) && (head f_mrdl) == (head s_mrdl) -- do we need kicker logic?
then (1, 1)
else (0, 1)
else (0, 0)
card_deck :: [Card]
card_deck = [(r, s) | r <- [2 .. 14], s <- ['C', 'D', 'H', 'S']]
need_kicker_logic :: [Card] -> (Int, Int)
need_kicker_logic cards = visit_subset cards (length cards) [] 0 (0, 0)
where visit_subset a_cards num_a_cards picked_cards num_picked_cards result#(num_kicker_logic, num_clear_winners)
| num_cards_needed == 0 = (num_kicker_logic + nkl, num_clear_winners + ncw)
| num_cards_needed > num_a_cards = result
| otherwise = let result_1 = visit_subset (tail a_cards)
(num_a_cards - 1)
picked_cards
num_picked_cards
result
result_2 = visit_subset (tail a_cards)
(num_a_cards - 1)
((head a_cards) : picked_cards)
(num_picked_cards + 1)
result_1
in result_2
where num_cards_needed = 10 - num_picked_cards
(nkl, ncw) = check_kicker_logic picked_cards
main :: IO ()
main =
do
putStrLn $ show $ need_kicker_logic card_deck
I'm solving the Brigde and torch problem
in Haskell.
I wrote a function that given a state of the puzzle, as in which people have yet to cross and those who have crossed, gives back a list of all possible moves from one side to the other (moving two people forwards and one person backwards).
module DarkBridgeDT where
data Crossing = Trip [Float] [Float] Float deriving (Show)
data RoundTrip = BigTrip Crossing Crossing deriving (Show)
trip :: [Float] -> [Float] -> Float -> Crossing
trip x y z = Trip x y z
roundtrip :: Crossing -> Crossing -> RoundTrip
roundtrip x y = BigTrip x y
next :: Crossing -> [RoundTrip]
next (Trip [] _ _) = []
next (Trip (a:b:[]) s _ )
|a>b = [BigTrip (Trip [] (a:b:s) a) (Trip [] [] 0)]
|otherwise = [BigTrip (Trip [] (b:a:s) b) (Trip [] [] 0)]
next (Trip d s _) = [BigTrip (Trip [x,z] (i:j:s) j) b | i <- d, j <- d, i < j, x <- d, z <- d, x < z, z /= i, z /= j, x /= z, x /= i, x /= j, b <- (back [x,z] (i:j:s))]
where
back [] s = []
back d s = [Trip (i:d) (filter (/= i) s) i | i <- s]
Now I need a function that given a state as the one above and a maximum amount of time gives back all possible solutions to the puzzle in less than that given time.
All I have for that is this:
cross :: Crossing -> Float -> [[RoundTrip]]
cross (Trip [] _ _) _ = []
cross (Trip _ _ acu) max
| acu > max = []
cross (Trip a b acu) max = map (cross (map (crec) (next (Trip a b acu)) acu)) max
where
crec (BigTrip (Trip _ _ t1) (Trip a b t2)) acu = (Trip a b (t1+t2+acu))
Of course that doesn't compile, the 5th line is the one that's driving me insane. Any input?
Edit:
The cross function is meant to apply the next function to every result of the last nextfunction called.
If the first result of next was something like: [A,B,C,D] then it would call next on A B C and D to see if any or all of those get to a solution in less than max (A B C and D would be Crossings inside which contain the floats that are the time that ads up and is compared to max).
My data structure is
Crossing: Contains the first side of the bridge (the people in it represented by the time they take to cross the bridge) the other side of the bridge (the same as the other) and a time that represents the greatest time that last crossed the bridge (either the greatest of the two in the first crossing or the only one in the second) or the amount of time acumulated crossing the bridge (in the cross function).
RoundTrip: Represents two crossings, the first and the second, the one getting to safety and the one coming back to danger.
cross (Trip [1,2,5,10] [] 0) 16 should give an empty list for there is no solution that takes less than 17 minutes (or whatever time unit).
cross (Trip [1,2,5,10] [] 0) 17 should give the normal solution to the puzzle as a list of roundtrips.
I hope that makes it clearer.
Edit2:
I finally got it. I read Carsten's solution before I completed mine and we laid it out practically the same. He used fancier syntax and more complex structures but it's really similar:
module DarkBridgeST where
data Torch = Danger | Safety deriving (Eq,Show)
data State = State
[Float] -- people in danger
[Float] -- people safe
Torch -- torch position
Float -- remaining time
deriving (Show)
type Crossing = [Float]
classic :: State
classic = State [1,2,5,10] [] Danger 17
next :: State -> [Crossing] -- List all possible moves
next (State [] _ _ _) = [] -- Finished
next (State _ [] Safety _) = [] -- No one can come back
next (State danger _ Danger rem) = [[a,b] | a <- danger, b <- danger, a /= b, a < b, max a b <= rem]
next (State _ safe Safety rem) = [[a] | a <- safe, a <= rem]
cross :: State -> Crossing -> State -- Crosses the bridge depending on where the torch is
cross (State danger safe Danger rem) cross = State (taking cross danger) (safe ++ cross) Safety (rem - (maximum cross))
cross (State danger safe Safety rem) cross = State (danger ++ cross) (taking cross safe) Danger (rem - (maximum cross))
taking :: [Float] -> [Float] -> [Float]
taking [] d = d
taking (x:xs) d = taking xs (filter (/=x) d)
solve :: State -> [[Crossing]]
solve (State [] _ _ _) = [[]]
solve sf = do
c <- next sf
let sn = cross sf c
r <- solve sn
return (c:r)
All in all thanks everyone. I'm new to Haskell programming and this helped me understand a lot of things. I hope this post can also help someone starting haskell like me one day :)
I'm not going to leave much of your code intact here.
The first problems are with the data structures. Crossing doesn't actually represent anything to do with crossing the bridge, but the state before or after a bridge crossing. And you can't use RoundTrip because the number of bridge crossings is always odd.
I'm renaming the data structure I'm actually keeping, but I'm not keeping it unmodified.
data Bank = Danger | Safety deriving (Eq,Show)
data PuzzleState = PuzzleState
[Float] -- people still in danger
[Float] -- people on the safe bank
Bank -- current location of the torch
Float -- remaining time
type Crossing = ([Float],Bank)
Modifying/writing these functions is left as an exercise for the reader
next :: PuzzleState -> [Crossing] -- Create a list of possible crossings
applyCrossing :: PuzzleState -> Crossing -> PuzzleState -- Create the next state
Then something like this function can put it all together (assuming next returns an empty list if the remaining time is too low):
cross (PuzzleState [] _ _ _) = [[]]
cross s1 = do
c <- next s1
let s2 = applyCrossing s1 c
r <- cross s2
return $ c : r
Just for the fun, an approach using a lazy tree:
import Data.List
import Data.Tree
type Pawn = (Char, Int)
data Direction = F | B
data Turn = Turn {
_start :: [Pawn],
_end :: [Pawn],
_dir :: Direction,
_total :: Int
}
type Solution = ([String], Int)
-- generate a tree
mkTree :: [Pawn] -> Tree Turn
mkTree p = Node{ rootLabel = s, subForest = branches s }
where s = Turn p [] F 0
-- generates a node for a Turn
mkNode :: Turn -> Tree Turn
mkNode t = Node{ rootLabel = t, subForest = branches t }
-- next possible moves
branches :: Turn -> [Tree Turn]
-- complete
branches (Turn [] e d t) = []
-- moving forward
branches (Turn s e F t) = map (mkNode.turn) (next s)
where
turn n = Turn (s\\n) (e++n) B (t+time n)
time = maximum . map snd
next xs = [x| x <- mapM (const xs) [1..2], head x < head (tail x)]
-- moving backward
branches (Turn s e B t) = map (mkNode.turn) e
where
turn n = Turn (n:s) (delete n e) F (t+time n)
time (_,b) = b
solve :: Int -> Tree Turn -> [Solution]
solve limit tree = solve' [] [] limit tree
where
solve' :: [Solution] -> [String] -> Int -> Tree Turn -> [Solution]
solve' sols cur limit (Node (Turn s e d t) f)
| and [t <= limit, s == []] = sols ++ [(cur++[step],t)]
| t <= limit = concat $ map (solve' sols (cur++[step]) limit) f
| otherwise = []
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]"
v = map fst
Then you you can get a list of solutions:
solve 16 $ mkTree [('a',2), ('b',4), ('c',8)]
=> [(["[abc|]","[c|ab]","[ac|b]","[|bac]"],14),(["[abc|]","[c|ab]","[bc|a]","[|abc]"],16),(["[abc|]","[b|ac]","[ab|c]","[|cab]"],14),(["[abc|]","[a|bc]","[ba|c]","[|cab]"],16)]
Or also generate a tree of solutions:
draw :: Int -> Tree Turn -> Tree String
draw limit (Node (Turn s e d t) f)
| t > limit = Node "Time Out" []
| s == [] = Node ("Complete: " ++ step) []
| otherwise = Node step (map (draw limit) f)
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]" ++ " - " ++ (show t)
v = map fst
Then:
putStrLn $ drawTree $ draw 16 $ mkTree [('a',2), ('b',4), ('c',8)]
Will result in:
[abc|] - 0
|
+- [c|ab] - 4
| |
| +- [ac|b] - 6
| | |
| | `- Complete: [|bac] - 14
| |
| `- [bc|a] - 8
| |
| `- Complete: [|abc] - 16
|
+- [b|ac] - 8
| |
| +- [ab|c] - 10
| | |
| | `- Complete: [|cab] - 14
| |
| `- [cb|a] - 16
| |
| `- Time Out
|
`- [a|bc] - 8
|
+- [ba|c] - 12
| |
| `- Complete: [|cab] - 16
|
`- [ca|b] - 16
|
`- Time Out
I'm trying to complete the last part of my Haskell homework and I'm stuck, my code so far:
data Entry = Entry (String, String)
class Lexico a where
(<!), (=!), (>!) :: a -> a -> Bool
instance Lexico Entry where
Entry (a,_) <! Entry (b,_) = a < b
Entry (a,_) =! Entry (b,_) = a == b
Entry (a,_) >! Entry (b,_) = a > b
entries :: [(String, String)]
entries = [("saves", "en vaut"), ("time", "temps"), ("in", "<`a>"),
("{", "{"), ("A", "Un"), ("}", "}"), ("stitch", "point"),
("nine.", "cent."), ("Zazie", "Zazie")]
build :: (String, String) -> Entry
build (a, b) = Entry (a, b)
diction :: [Entry]
diction = quiksrt (map build entries)
size :: [a] -> Integer
size [] = 0
size (x:xs) = 1+ size xs
quiksrt :: Lexico a => [a] -> [a]
quiksrt [] = []
quiksrt (x:xs)
|(size [y|y <- xs, y =! x]) > 0 = error "Duplicates not allowed."
|otherwise = quiksrt [y|y <- xs, y <! x]++ [x] ++ quiksrt [y|y <- xs, y >! x]
english :: String
english = "A stitch in time save nine."
show :: Entry -> String
show (Entry (a, b)) = "(" ++ Prelude.show a ++ ", " ++ Prelude.show b ++ ")"
showAll :: [Entry] -> String
showAll [] = []
showAll (x:xs) = Main.show x ++ "\n" ++ showAll xs
main :: IO ()
main = do putStr (showAll ( diction ))
The question asks:
Write a Haskell programs that takes
the English sentence 'english', looks
up each word in the English-French
dictionary using binary search,
performs word-for-word substitution,
assembles the French translation, and
prints it out.
The function 'quicksort' rejects
duplicate entries (with 'error'/abort)
so that there is precisely one French
definition for any English word. Test
'quicksort' with both the original
'raw_data' and after having added
'("saves", "sauve")' to 'raw_data'.
Here is a von Neumann late-stopping
version of binary search. Make a
literal transliteration into Haskell.
Immediately upon entry, the Haskell
version must verify the recursive
"loop invariant", terminating with
'error'/abort if it fails to hold. It
also terminates in the same fashion if
the English word is not found.
function binsearch (x : integer) : integer
local j, k, h : integer
j,k := 1,n
do j+1 <> k --->
h := (j+k) div 2
{a[j] <= x < a[k]} // loop invariant
if x < a[h] ---> k := h
| x >= a[h] ---> j := h
fi
od
{a[j] <= x < a[j+1]} // termination assertion
found := x = a[j]
if found ---> return j
| not found ---> return 0
fi
In the Haskell version
binsearch :: String -> Integer -> Integer -> Entry
as the constant dictionary 'a' of type
'[Entry]' is globally visible. Hint:
Make your string (English word) into
an 'Entry' immediately upon entering
'binsearch'.
The programming value of the
high-level data type 'Entry' is that,
if you can design these two functions
over the integers, it is trivial to
lift them to to operate over Entry's.
Anybody know how I'm supposed to go about my binarysearch function?
The instructor asks for a "literal transliteration", so use the same variable names, in the same order. But note some differences:
the given version takes only 1
parameter, the signature he gives
requires 3. Hmmm,
the given version is not recursive, but he asks for a
recursive version.
Another answer says to convert to an Array, but for such a small exercise (this is homework after all), I felt we could pretend that lists are direct access. I just took your diction::[Entry] and indexed into that. I did have to convert between Int and Integer in a few places.
Minor nit: You've got a typo in your english value (bs is a shortcut to binSearch I made):
*Main> map bs (words english)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),*** Exception: Not found
*Main> map bs (words englishFixed)
[Entry ("A","Un"),Entry ("stitch","point"),Entry ("in","<`a>"),Entry ("time","te
mps"),Entry ("saves","en vaut"),Entry ("nine.","cent.")]
*Main>
A binary search needs random access, which is not possible on a list. So, the first thing to do would probably be to convert the list to an Array (with listArray), and do the search on it.
here's my code for just the English part of the question (I tested it and it works perfectly) :
module Main where
class Lex a where
(<!), (=!), (>!) :: a -> a -> Bool
data Entry = Entry String String
instance Lex Entry where
(Entry a _) <! (Entry b _) = a < b
(Entry a _) =! (Entry b _) = a == b
(Entry a _) >! (Entry b _) = a > b
-- at this point, three binary (infix) operators on values of type 'Entry'
-- have been defined
type Raw = (String, String)
raw_data :: [Raw]
raw_data = [("than a", "qu'un"), ("saves", "en vaut"), ("time", "temps"),
("in", "<`a>"), ("worse", "pire"), ("{", "{"), ("A", "Un"),
("}", "}"), ("stitch", "point"), ("crime;", "crime,"),
("a", "une"), ("nine.", "cent."), ("It's", "C'est"),
("Zazie", "Zazie"), ("cat", "chat"), ("it's", "c'est"),
("raisin", "raisin sec"), ("mistake.", "faute."),
("blueberry", "myrtille"), ("luck", "chance"),
("bad", "mauvais")]
cook :: Raw -> Entry
cook (x, y) = Entry x y
a :: [Entry]
a = map cook raw_data
quicksort :: Lex a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort (filter (<! x) xs) ++ [x] ++ quicksort (filter (=! x) xs) ++ quicksort (filter (>! x) xs)
getfirst :: Entry -> String
getfirst (Entry x y) = x
getsecond :: Entry -> String
getsecond (Entry x y) = y
binarysearch :: String -> [Entry] -> Int -> Int -> String
binarysearch s e low high
| low > high = " NOT fOUND "
| getfirst ((e)!!(mid)) > s = binarysearch s (e) low (mid-1)
| getfirst ((e)!!(mid)) < s = binarysearch s (e) (mid+1) high
| otherwise = getsecond ((e)!!(mid))
where mid = (div (low+high) 2)
translator :: [String] -> [Entry] -> [String]
translator [] y = []
translator (x:xs) y = (binarysearch x y 0 ((length y)-1):translator xs y)
english :: String
english = "A stitch in time saves nine."
compute :: String -> [Entry] -> String
compute x y = unwords(translator (words (x)) y)
main = do
putStr (compute english (quicksort a))
An important Prelude operator is:
(!!) :: [a] -> Integer -> a
-- xs!!n returns the nth element of xs, starting at the left and
-- counting from 0.
Thus, [14,7,3]!!1 ~~> 7.