Homework: Doing a binary search on some elements in Haskell

Question

Hello, 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?

Answer 1

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.

Answer 2

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>

Answer 3

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.

Answer 4

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))