Operation on newly created data (update an array) - haskell

I've created the following data types.
{- Data declaration predefined in Haskell -}
data Maybe_ a = Nothing_ | Just_ a deriving( Show )
{- Array declaration -}
data Array_ a = A [ ( Int, Maybe_ a ) ] deriving( Show )
Now, I'd like to create an update function that - given an index, an Array_ and a new value - update the value of the array at the given index.
Here's the signature of the function ...
update :: ( Int, Array_ a, a ) -> Array_ a
... and here's the complete function
update :: ( Int, Array_ a, a ) -> Array_ a
update( i, A[], new_value ) = error( ( show i ) ++ " is not an index" )
update( i, A( ( j, Just_ x ):l ), new_value )
| i == j = A( ( j, Just_ new_value ):l )
| i /= j = update ( i, A l, new_value )
The issue occurs at the last line of the function. It's a recursive call to the end of the list, but it doesn't keep the previously consider elements of the array.
I was thinking of using either the ++ operator or the : one, but both of the time I get an error.
... i /= j = ( j, Just_ x ):update ( i, A l, new_value )
... i /= j = A[( j, Just_ x )] ++ update ( i, A l, new_value )
How can I handle this differently?

First of all it is a bit un-Haskell to work with tuples, usually you define separate parameters, like:
update :: Int -> Array_ a -> a -> Array_ a
So that you can easily work with an update 5 function where you will later provide additional arguments.
Nevertheless the problem is that in your last branch:
| i /= j = update i (A l) new_value
you thus perform a recursive call, but the result of that recursive call will be the final result. In order to solve this issue, you simply prepend the item that you inspected, and did not match the index. Since you do this for all index failure, all indices that do not match will be in the final result, so:
| i /= j = (j, Just_ x) : update i (A l) new_value.
So now we obtain:
update :: Int -> Array_ a -> a -> Array_ a
update i (A []) new_value = error( ( show i ) ++ " is not an index" )
update i (A ((j, Just_ x):l)) new_value
| i == j = A ((j, Just_ new_value):l)
| i /= j = let A t = update i (A l) new_value in A ((j, Just_ x):t)
That being said there are still some things we can do to improve our function:
variables we do not take into account are usually written with a wildcard,
we can use an alias # to prevent us from repacking the head of the list.
the compiler will probably error since you use == and /=. It is better to use otherwise (an alias of True in the last branch (this is more or less equivalent with else in Java).
there are some additional beautifications you can obtain with hlint.
If we take the above comments into account, an - in my opinion - more elegant function would be:
update :: Int -> Array_ a -> a -> Array_ a
update i (A []) _ = error $ show i ++ " is not an index"
update i (A (h#(j,Just_):l)) new_value
| i == j = A ((j, Just_ new_value):l)
| otherwise = let A t = update i (A l) new_value in A (h:t)
Finally there is still a case unresolved: what to do if there are Nothing_s in your list. If you don't care whether the value is a Just_ x or a Nothing_, you can rewrite it like:
update :: Int -> Array_ a -> a -> Array_ a
update i (A []) _ = error $ show i ++ " is not an index"
update i (A (h#(j,_):l)) new_value
| i == j = A ((j, Just_ new_value):l)
| otherwise = let A t = update i (A l) new_value in A (h:t)

Related

Propositional logic in haskell

I have the following data types
data Prop =
Var Name
| Neg Prop
| Conj Prop Prop
| Disy Prop Prop
| Impl Prop Prop
| Syss Prop Prop deriving Show -- if and only if
-- And the following
type Name = String
type State = (Name, Bool) -- The state of a proposition, Example ("P", True), ("Q", True)
type States = [State] -- A list of states, [("P", True), ("Q", False), ...]
type Row = (States, Bool) -- A row of the table. ([("P", True), ("Q", False), ...], True)
type Table = [Row]
The case is that I want to generate all the possible states of a proposition
P, Q, R
1 1 1
1 1 0
1 0 1
...
To do this, I create auxiliary functions to gradually build the states
-- Get all the atoms of a proposition
varList :: Prop -> [Name]
varList (Var p) = [p]
varList (Neg p) = varList p
varList (Conj p q) = varList p ++ varList q
varList (Disy p q) = varList p ++ varList q
varList (Impl p q) = varList p ++ varList q
varList (Syss p q) = varList p ++ varList q
--Power set to get all values
conjPoten :: Eq a => [a] -> [[a]]
conjPoten [] = [[]]
conjPoten (x:xs) = map (x: ) pt `union` pt
where
pt = conjPoten xs
-- Give value to a proposition, "P" -> True, "" -> False
giveValue:: Name -> Bool
giveValue p = p /= []
-- Generate a State, "P" -> ("P",True), "" -> ("",False)
generateState :: Name -> State
generateState p = (p , daValor p)
-- The function that I want
generateStates:: [Name] -> States
generateStates p = [(a,True) | a <-p]
This, of course, is a test to verify that "it works", because if
generateStates ["P","Q", "R"] = [("P",True),("Q",True),("R",True)]
I did this thinking that in the power set we are going to have cases like ["P","Q","R"] and ["P","Q"], that is, there is not going to be "R". So the intention is that
["P","Q","R"] gives us [("Q",True),("P",True),("R",True)] and
["P","Q"] gives us [("Q",True),("P",True),("R",False)]
But from here I have two questions
The first is, that I have to modify the second element of the tuple, so what I came up with was
generateStates :: [Name] -> States
generateStates p = [ (a, b) | a<- p, a<- giveValue p]
The main error that the prelude marks me is:
Couldn't match type ‘[Char]’ with ‘Char’
Which I understand, because p is a list and giveValue works with a Name, not with a list of Names
So my question is: How do I get that p out of a Name? and that it does not stay as a list of Name
I tried to do it like
generateStates :: [Name] -> States
generateStates [p] = [ (p, b) | a<- giveValue p]
But that tells me:
Couldn't match expected type ‘[Bool]’ with actual type ‘Bool’
Which, now I don't understand, plus it tells me there aren't enough patterns
Why does this happen?
The other question is that, having
generateStates :: [Name] -> States
generateStates p = [ (a, True) | a<-p]
and try it with
generateStates ["P","Q"] would only give me [("Q",True),("P",True)]
But we have P, Q and R, so I'm missing the ("R", False)
But since it is in the arguments that we pass, it cannot add it to the list
Where do I get that R? those missing variables?
Thanks!
To change the tuple, you really create a new one, as they are not mutable. You could create a function using pattern matching. The below function works on pairs (tuples with two elements).
modTuple (firstValue, secondValue) updatedValue = (firstValue, updatedValue)
Alternatively you could access the members of the tuple with the built-in fst and snd to access the first and second elements, and create a new tuple.
You can use pattern matching to access individual elements of a list, and build up States recursively. I.e.
generateStates [] = []
generateStates (p:ps) = (p, giveValue p):(generateStates ps)

Slow import and automatic generation of code from XML

I've been playing with Haskell and writing some code to parse DICOM medical images. The code is here. I wanted to create a function that will take in a ByteString and return a name. So a certain ByteString (actually two Int64s taken from a ByteString) would return PatientName or StudyDate for example. There are thousands of these and they are all contained within an XML file. So to create the function I parse the XML file and generate the desired function and output to a file using
writeTagNameFromElemGroup :: FilePath -> [(String,String,String,String)] -> IO()
writeTagNameFromElemGroup fp tups = init >> Prelude.appendFile fp ( Prelude.drop 0 tags )
where init = Prelude.appendFile fp "\ntagNameFromElem :: Element -> Group -> String\ntagNameFromElem e g\n"
tags = LS.concat $ Prelude.map (\tup -> " | " ++ (writeTup tup) ++ "\n") filTups
hexInt x = show . readHex $ x
filTups = LS.filter (\(w,x,y,z) -> Prelude.length w == 4 && Prelude.length x ==4 ) tups
This creates the desired function in Tags.hs
tagNameFromElem :: Int64 -> Int64 -> String
tagNameFromElem e g
| e == 8 && g == 1 = "LengthToEnd"
| e == 8 && g == 5 = "SpecificCharacterSet"
| e == 8 && g == 6 = "LanguageCodeSequence"
| e == 8 && g == 8 = "ImageType"
| e == 8 && g == 16 = "RecognitionCode"
| e == 8 && g == 18 = "InstanceCreationDate"
| e == 8 && g == 19 = "InstanceCreationTime"
| e == 8 && g == 20 = "InstanceCreatorUID"
| e == 8 && g == 22 = "SOPClassUID"
| e == 8 && g == 24 = "SOPInstanceUID"
| e == 8 && g == 26 = "RelatedGeneralSOPClassUID"
| e == 8 && g == 27 = "OriginalSpecializedSOPClassUID"
..... > 2000 more
Every so often there is a special case like
| e == 1000 && mod (g -5) 10 == 0 = "ShiftTableTriplet"
which put me off just using a map.
Now this approach works but it takes a very long time to load (Over a minute) the whole which makes me think that I'm not doing this how it should be done. To reproduce I suggest cloning the repo and loading the Tags.hs.
A SSCE
writeFunc :: (Num x, Show x) => FilePath -> [x] -> IO()
writeFunc fp xs = init >> Prelude.appendFile fp ( maps ) >> Prelude.appendFile fp "| otherwise = 0 "
where init = Prelude.appendFile fp "mapVal :: Int -> Int \nmapVal x\n "
maps = concat $ Prelude.map (\x -> "| x == " ++ show x ++ " = " ++ show (x +1 ) ++ "\n ") xs
Use a long list ~ few thousand values and try to import the resulting file
This answer is based on what bheklilr suggested in the question's comments. Code generation is up to you.
I reviewed your code and found that there are only two values in which e imposes special conditions on g: e == 28 and e == 1000. So, it'd be better to handle those in separate functions. Choose better names than the following ones, please.
e28 :: Map Int64 String
e28 = fromList [ (0, "CodeLabel"), (2, "NumberOfTables"), ... ]
e1000 :: Map Int64 String
e1000 :: fromList [ (0, "EscapeTriplet"), (1, "RunLengthTriplet"), ... ]
The keys of the previous maps are taken from your special-case predicate: mod (g - key) 10 == 0.
The case where e == 1010 is also special, since it doesn't depend on g. It's always "ZonalMap", so it'll be dealt with later.
Now, just create the rest of maps using g as key.
e40 :: Map Int64 String
e40 = fromList [ (2, "SamplesPerPixel"), (3, "SamplesPerPixelUsed"), ... ]
e84 :: Map Int64 String
e84 = fromList [ ... ]
...
Create a map from regular es (i.e. not the 28, 1000 or 1010 ones) to their corresponding map:
regularE :: Map Int64 (Map Int64 String)
regularE e = fromList [ (40, e40), (84, e84), ... ]
To sum it all up:
import Control.Monad
tagNameFromElem :: Int64 -> Int64 -> Maybe String
tagNameFromElem 28 g = lookup e28 (mod g 10)
tagNameFromElem 1000 g = lookup e1000 (mod g 10)
tagNameFromElem 1010 _ = Just "ZonalMap"
tagNameFromElem e g = lookup regularE e >>= (`lookup` g)
The lookup function is from Data.Map, just in case qualification is required. Using Maybe handles the case where e or g do not map to a valid tag name, instead of a hardcoded "Not Found" string.
Note that I haven't tested this code; I'm not at home right now.
If you want, try IntMap instead of Map. You'll need to work with regular Ints in this case, but it may be good for this project.

Haskell Knapsack

I've written an answer to the bounded knapsack problem with one of each item in Scala, and tried transposing it to Haskell with the following result:
knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
knapsack xs [] _ = xs
knapsack xs ys max =
foldr (maxOf) [ ] [ knapsack ( y : xs ) ( filter (y /=) ys ) max | y <- ys
, weightOf( y : xs ) <= max ]
maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
maxOf a b = if valueOf a > valueOf b then a else b
valueOf :: [ ( Int, Int ) ] -> Int
valueOf [ ] = 0
valueOf ( x : xs ) = fst x + valueOf xs
weightOf :: [ ( Int, Int ) ] -> Int
weightOf [ ] = 0
weightOf ( x : xs ) = snd x + weightOf xs
I'm not looking for tips on how to clean up the code, just to get it working. To my knowledge it should be doing the following:
For each tuple option (in ys)
if the weight of the current tuple (y) and the running total (xs) combined is less than the capacity
get the optimal knapsack that contains the current tuple and the current total (xs), using the available tuples (in ys) less the current tuple
Finally, get the most valuable of these results and return it
*Edit: * Sorry, forgot to say what's wrong... So it compiles alright, but it gives the wrong answer. For the following inputs, what I expect and what it produces:
knapsack [] [(1,1),(2,2)] 5
Expect: [(1,1),(2,2)]
Produces: [(1,1),(2,2)]
knapsack [] [(1,1),(2,2),(3,3)] 5
Expect: [(2,2),(3,3)]
Produces: []
knapsack [] [(2,1),(3,2),(4,3),(6,4)] 5
Expect: [(2,1),(6,4)]
Produces: []
So I was wondering what could be the cause of the discrepancy?
The solution, thanks to sepp2k:
ks = knapsack []
knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
knapsack xs [] _ = xs
knapsack xs ys max =
foldr (maxOf) [ ] ( xs : [ knapsack ( y : xs ) ( ys #- y ) max
| y <- ys, weightOf( y : xs ) <= max ] )
(#-) :: [ ( Int, Int ) ] -> ( Int, Int ) -> [ ( Int, Int ) ]
[ ] #- _ = [ ]
( x : xs ) #- y = if x == y then xs else x : ( xs #- y )
maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
maxOf a b = if valueOf a > valueOf b then a else b
valueOf :: [ ( Int, Int ) ] -> Int
valueOf [ ] = 0
valueOf ( x : xs ) = fst x + valueOf xs
weightOf :: [ ( Int, Int ) ] -> Int
weightOf [ ] = 0
weightOf ( x : xs ) = snd x + weightOf xs
Which returns the expected results, above.
Your first case fires when ys contains. so for knapsack [foo,bar] [] 42, you get back [foo, bar], which is what you want. However it does not fire when ys contains nothing except elements that would put you over the max weight, i.e. knapsack [(x, 20), (y,20)] [(bla, 5)] will return [] and thus discard the previous result. Since this is not what you want you should adjust your cases so that the second case only fires if there's at least one element in ys that's below the max weight.
One way to do that would be to throw out any elements that put you over the max weight when recursing, so that that scenario simply can't happen.
Another way would be to switch the order of the cases and add a guard to the first case that says that ys must contain at least one element that does not put you over the total weight (and adjust the other case to not require ys to be empty).
PS: Another, unrelated problem with your code is that it ignores duplicates. I.e. if you use it on the list [(2,2), (2,2)] it will act as if the list was just [(2,2)] because filter (y /=) ys will throw out all occurrences of y, not just one.
Some improvements on your working version:
import Data.List
import Data.Function(on)
ks = knapsack []
knapsack :: [(Int, Int)] -> [(Int, Int)] -> Int -> [(Int, Int)]
knapsack xs [] _ = xs
knapsack xs ys max =
foldr (maxOf) [] (xs: [knapsack (y:xs) (delete y ys) max
| y <- ys, weightOf(y:xs) <= max ] ) where
weightOf = sum . map snd
maxOf :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
maxOf a b = maximumBy (compare `on` valueOf) [a,b] where
valueOf = sum . map fst
Might I suggest using a dynamic programming approach? This way of solving 0-1 knapsack problems are almost painfully slow, at least when the amount of variables gets larger than around 20. While it's simple, it's just too ineffective. Here's my shot at it:
import Array
-- creates the dynamic programming table as an array
dynProgTable (var,cap) = a where
a = array ((0,0),(length var,cap)) [ ((i,j), best i j)
| i <- [0..length var] , j <- [0..cap] ] where
best 0 _ = 0
best _ 0 = 0
best i j
| snd (var !! (i-1)) > j = a!decline
| otherwise = maximum [a!decline,value+a!accept]
where decline = (i-1,j)
accept = (i-1,j - snd (var !! (i-1)))
value = fst (var !! (i-1))
--Backtracks the solution from the dynamic programming table
--Output on the form [Int] where i'th element equals 1 if
--i'th variable was accepted, 0 otherwise.
solve (var,cap) =
let j = cap
i = length var
table = dynProgTable (var,cap)
step _ 0 _ = []
step a k 0 = step table (k-1) 0 ++ [0]
step a k l
| a!(k,l) == a!(k-1,l) = step a (k-1) l ++ [0]
| otherwise = step a (k-1) (l - snd (var !! (k-1))) ++ [1]
in step table i j
In the input (var,cap), var is a list of variables in the form of 2-tuples (c,w), where c is the cost and w is the weight. cap is the maximum weight allowance.
I'm sure above code could be cleaned up to make it more readable and obvious, but that's how it turned out for me :) Where the code snippet by Landei above is short, my computer took ages computing instances with only 20 variables. The dynamic programming approach above gave me a solution for 1000 variables faster.
If you don't know about dynamic programming, you should check out this link:Lecture slides on dynamic programming, it helped me a lot.
For an introduction to arrays, check out Array tutorial.

code wrong haskell Couldn't match expected type `[(Key, Value)]'

what is wrong with this piece of code, its in a case statement
loop :: Table -> IO ()
loop table = do
putStr "Command: "
x <- getLine
case x of
"add" -> do putStr "Key: "; y <- getLine; putStr "Value: "; z <- getLine; add y z table; loop table
add :: Key -> Value -> Table -> Table
add key v table | table == empty = [(key, v)]
| otherwise = ((key, v) : remove key table)
type Table = [(Key,Value)]
type Key = String
type Value = String
remove :: Key -> Table -> Table
remove key ((a, b) :table)
| key ==a = table
| ((a, b) :table) == empty = empty
| otherwise = ((a, b) : remove key table)
Here's your function again (reformatted a bit):
loop table = do
putStr "Command: "
x <- getLine
case x of "add" -> do
putStr "Key: "
y <- getLine
putStr "Value: "
z <- getLine
add y z table
loop table
The problem is that add y z table isn't an IO action like the putStrs before. You seem to think that the call to add actually modifies the table, which it doesn't!
As for fixing it: try assigning the result of add to something in a let clause. I'm not going to spell it out, since this look like homework.
My guess is that value y table should be putStrLn (value y table).
As things stand, you are looking up the value but not doing anything with the answer you get back.
Assuming that you have
type Key = String
somewhere, your value function is quite obscure here:
| lookup key ((a,b) : table) == Just b = b
This surely could be simplified to
| key == a = b
You also have some lingering bugs in remove
remove :: Key -> Table -> Table
remove key ((a, b) : etable)
| key == a = table
| ((a, b) : table) == empty = empty
| otherwise = ((a, b) : remove key table)
Ask yourself what should be tested for empty? What happens if a doesn't appear in table?

Doing a binary search on some elements in Haskell

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.

Resources