Related
So I'm trying to make a little program that can take in data captured during an experiment, and for the most part I think I've figured out how to recursively take in data until the user signals there is no more, however upon termination of data taking haskell throws Exception: <<loop>> and I can't really figure out why. Here's the code:
readData :: (Num a, Read a) => [Point a] -> IO [Point a]
readData l = do putStr "Enter Point (x,y,<e>) or (d)one: "
entered <- getLine
if (entered == "d" || entered == "done")
then return l
else do let l = addPoint l entered
nl <- readData l
return nl
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point (dataList !! 0) (dataList !! 1) (dataList !! 2)]
where dataList = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
checkInputData :: [String] -> [String]
checkInputData xs
| length xs < 2 = ["0","0","0"]
| length xs < 3 = (xs ++ ["0"])
| length xs == 3 = xs
| length xs > 3 = ["0","0","0"]
As far as I can tell, the exception is indication that there is an infinite loop somewhere, but I can't figure out why this is occurring. As far as I can tell when "done" is entered the current level should simply return l, the list it's given, which should then cascade up the previous iterations of the function.
Thanks for any help. (And yes, checkInputData will have proper error handling once I figure out how to do that.)
<<loop>> basically means GHC has detected an infinite loop caused by a value which depends immediately on itself (cf. this question, or this one for further technical details if you are curious). In this case, that is triggered by:
else do let l = addPoint l entered
This definition, which shadows the l you passed as an argument, defines l in terms of itself. You meant to write something like...
else do let l' = addPoint l entered
... which defines a new value, l', in terms of the original l.
As Carl points out, turning on -Wall (e.g. by passing it to GHC at the command line, or with :set -Wall in GHCi) would make GHC warn you about the shadowing:
<interactive>:171:33: warning: [-Wname-shadowing]
This binding for ‘l’ shadows the existing binding
bound at <interactive>:167:10
Also, as hightlighted by dfeuer, the whole do-block in the else branch can be replaced by:
readData (addPoint l entered)
As an unrelated suggestion, in this case it is a good idea to replace your uses of length and (!!) with pattern matching. For instance, checkInputData can be written as:
checkInputData :: [String] -> [String]
checkInputData xs = case xs of
[_,_] -> xs ++ ["0"]
[_,_,_] -> xs
_ -> ["0","0","0"]
addPoint, in its turn, might become:
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point x y z]
where [x,y,z] = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
That becomes even neater if you change checkInputData so that it returns a (String, String, String) triple, which would better express the invariant that you are reading exactly three values.
I'm trying to get a function that counts all paths from the root to a leaf that has an even number of nodes ( counting the root and the leaf)
My tree looks like this:
data Tree = Leaf Int | Node Int Tree Tree
all i got so far is a function that counts ALL nodes in a tree, which is easy enough:
countNodes (Leaf _) = 1
countNodes (Node _ x y) = 1+ countNodes x + countNodes y
Now i saw a bunch of questions that deal with trees but i felt like no answer helped me much, so I'm just gonna ask myself. How do i make a part of a function stop when a leaf is reached? I know this has to do with my problem to think with recursions.
What I tried to do was to to make list of all paths from the root, but i always end up with a function that gets all elements in the tree and puts them together somehow.
I'm missing something simple, please help. (or link me an answer that does exactly what i want)
I think the easiest way would be to make a data type that can describe a path through a tree:
data Path = L Path | R Path | End deriving (Eq, Show)
This type is basically a list but with two prepend constructors to tell you either go Left or go Right. This conveniently lets you look up items by path, or you can write a function that gives you a list of all paths in the tree.
-- Note that this can fail: lookupNode (Leaf 1) (L End) == Nothing
lookupNode :: Tree -> Path -> Maybe Tree
allPaths :: Tree -> [Path]
If you can write the allPaths function, then you can write the function you want on top of it. To start, just begin by listing the base cases:
allPaths (Leaf _) = [End]
allPaths (Node _ left right) = _
To fill in the hole _, think about what it means to list all the paths starting at a Node and recursing down left. You would need to have a L at the beginning of all of those paths, so you can put the following in there
allPaths (Node _ left right) = (map L $ allPaths left)
Similarly, you would need to handle the right tree:
allPaths (Node _ left right) =
(map L $ allPaths left) ++
(map R $ allPaths right)
So now:
> let tree =
Node 1
(Node 2 -- L _
(Leaf 3) -- L (L End)
(Node 4 -- L (R _)
(Leaf 5) -- L (R (L End))
(Leaf 6) -- L (R (R End))
)
)
(Leaf 7) -- R End
> allPaths tree
[L (L End),L (R (L End)), L (R (R End)),R End]
Now, to find the Leafs with an even number of nodes above them, first write a function that calculates a path length:
pathLength :: Path -> Int
pathLength End = 0
pathLength (L rest) = 1 + pathlength rest
pathLength (R rest) = 1 + pathLength rest
evenNodeCountPaths :: Tree -> [Path]
evenNodeCountPaths tree = filter (even . pathLength) $ allPaths tree
Note: It is possible to do this with
data Dir = L | R | End
type Path = [Dir]
But that can lead to invalid paths like [End, End, L, R, End], which just doesn't make any sense. I chose to go for the list-like data Path for this reason. You have to write your own pathLength function, but this formulation makes it impossible to have invalid paths.
Probably it's easier to compute both the number of even and the number of odd paths.
evenAndOdd (Leaf _) = (0, 1)
evenAndOdd (Node _ l r) = let
(el, ol) = evenAndOdd l
(er, or) = evenAndOdd r
in (ol+or, el+er)
If you really must, you can then define a function in terms of this to count just the even paths.
evenOnly = fst . evenAndOdd
Assume I have a binary tree:
data Bst a = Empty | Node (Bst a) a (Bst a)
I have to write a function that searches for a value and returns the number of its children. If there is no node with this value, it returns -1. I was trying to write both BFS and DFS, and I failed with both.
Pattern matching is your friend. Your Bst can either be Empty or a Node, so at the toplevel, your search function will be
search Empty = ...
search (Node left x right) = ...
Can an Empty tree possibly contain the target value? With a Node the target value, if present, will be either the node value (x above), in the left subtree, in the right subtree—or perhaps some combination of these.
By “return[ing] the number of its children,” I assume you mean the total number of descendants of the Bst rooted at a Node whose value is the target, which is an interesting combination of problems. You will want another function, say numChildren, whose definition uses pattern matching as above. Considerations:
How many descendants does an Empty tree have?
In the Node case, x doesn’t count because you want descendants. If only you had a function to count the number of children in the left and right subtrees …
Here is a way to do this. Breath-first search can actually be a bit tricky to implement and this solution (findBFS) has aweful complexity (appending to the list is O(n)) but you'll get the gist.
First I have decided to split out the finding functions to return the tree where the node element matches. That simplifies splitting out the counting function. Also, it is easier to return the number of elements than the number of descendants and return -1 in case not found, so the numDesc functions rely on the numElements function.
data Tree a = Empty
| Node a (Tree a) (Tree a)
numElements :: Tree a -> Int
numElements Empty = 0
numElements (Node _ l r) = 1 + numElements l + numElements r
findDFS :: Eq a => a -> Tree a -> Tree a
findDFS _ Empty = Empty
findDFS x node#(Node y l r) | x == y = node
| otherwise = case findDFS x l of
node'#(Node _ _ _) -> node'
Empty -> findDFS x r
findBFS :: Eq a => a -> [Tree a] -> Tree a
findBFS x [] = Empty
findBFS x ((Empty):ts) = findBFS x ts
findBFS x (node#(Node y _ _):ts) | x == y = node
findBFS x ((Node _ l r):ts) = findBFS x (ts ++ [l,r])
numDescDFS :: Eq a => a -> Tree a -> Int
numDescDFS x t = numElements (findDFS x t) - 1
numDescBFS :: Eq a => a -> Tree a -> Int
numDescBFS x t = numElements (findBFS x [t]) - 1
module Main where
import Data.List
import Data.Function
type Raw = (String, String)
icards = [("the", "le"),("savage", "violent"),("work", "travail"),
("wild", "sauvage"),("chance", "occasion"),("than a", "qu'un")]
data Entry = Entry {wrd, def :: String, len :: Int, phr :: Bool}
deriving Show
-- French-to-English, search-tree section
entries' :: [Entry]
entries' = map (\(x, y) -> Entry y x (length y) (' ' `elem` y)) icards
data Tree a = Empty | Tree a (Tree a) (Tree a)
tree :: Tree Entry
tree = build entries'
build :: [Entry] -> Tree Entry
build [] = Empty
build (e:es) = ins e (build es)
ins :: Entry -> Tree Entry -> Tree Entry
...
find :: Tree Entry -> Word -> String
...
translate' :: String -> String
translate' = unwords . (map (find tree)) . words
so i'm trying to design function ins and find but i am not sure where to start.any ideas?
I have no idea by which criteria the tree should be sorted, so I use just wrd. Then it would look like:
ins :: Entry -> Tree Entry -> Tree Entry
ins entry Empty = Tree entry Empty Empty
ins entry#(Entry w _ _ _) (Tree current#(Entry w1 _ _ _) left right)
| w == w1 = error "duplicate entry"
| w < w1 = Tree current (ins entry left) right
| otherwise = Tree current left (ins entry right)
How to get there?
As always when using recursion, you need a base case. Here it is very simple: If the tree is empty, just replace it by a node containing your data. There are no children for the new node, so we use Empty.
The case if you have a full node looks more difficult, but this is just due to pattern matching, the idea is very simple: If the entry is "smaller" you need to replace the left child with a version that contains the entry, if it is "bigger" you need to replace the right child.
If both node and entry have the same "size" you have three options: keep the old node, replace it by the new one (keeping the children) or throw an error (which seems the cleanest solution, so I did it here).
A simple generalization of Landei's answer:
ins :: Ord a => a -> Tree a -> Tree a
ins x Empty = Tree x Empty Empty
ins x (Tree x' l r) = case compare x x' of
EQ -> undefined
LT -> Tree x' (ins x l) r
GT -> Tree x' l (ins x r)
For this to work on Tree Entry, you will need to define an instance of Ord for Entry.
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.