Error: Non-exhaustive patterns in Haskell - haskell

I have some code that deals with a list of lists (that represents a matrix). Each cell is an N or a B. I want to represent the matrix with the number of Ns for each line. For example: [[B,B,N],[N,N,N]] is represented by [1,3].
Here's my code:
data Case = B|N deriving (Show, Eq)
type Grille =[[Case]]
g0,g1 :: Grille
g0 = [[B,B,B,B,B,B,N],[B,B,N,B,N,B,B],[N,B,N,N,N,N,N],[B,B,B,N,N,B,N],[N,N,N,B,B,B,B],[B,B,B,N,N,B,N]]
g1 = [[B,B,B,B,B,B,B],[B,B,N,N,N,B,B],[B,B,N,N,N,N,N],[B,B,B,N,N,N,N],[N,N,N,B,B,B,B],[B,B,B,N,B,B,B]]
projH :: Grille -> [Int]
projH [[]] = []
projH (x:xg) = testCase(x) ++ projH(xg)
testCase :: [Case] -> [Int]dans une ligne
testCase [] = [0]
testCase (x:xs)
| x == N = [head(testCase(xs))+1]
| otherwise = testCase(xs)
The problem is in the function projH, I'm obviously missing a pattern, but I do handle the case with [[],...] with the testCase function and the [[]] case. I don't know why it throws me this error:
*Main> projH g0
[1,2,6,3,3,3*** Exception: devoir.hs:(17,1)-(18,39): Non-exhaustive patterns in function projH

projH [] = []
instead of your
projH [[]] = []
As the case you wrote is already handled by the other statement by assigning x = [] and xg = []

Related

How can i solve this in haskell? [duplicate]

This question already has answers here:
Better exception for non-exhaustive patterns in case
(2 answers)
Closed 4 years ago.
I got this code to make a transposed matrix, but it doesn't work 100% fine.
type Mat a = [[a]]
transpose' :: Eq a => Mat a -> Mat a
transpose' [] = []
transpose' (h:t) = primelem (h:t):transpose' (eliminate' (h:t))
primelem :: Mat a -> [a]
primelem [] = []
primelem [[x]] = [x]
primelem ((x:xs):t) = x : primelem t
eliminate' :: Eq a => Mat a -> Mat a
eliminate' [] = []
eliminate' (h:t) = (delete (head h) h):eliminate' t
*Main> transpose' [[1,2,3],[0,4,5],[0,06]]
[[1,0,0],[2,4,6],[3,5*** Exception:(..)Non-exhaustive patterns in function primelem
I am trying to figure it out, but i really don't know which case is missing.
To discover which cases you are missing, you should turn on warnings using the -Wall flag, as shown in the GHCi session below.
> :set -Wall
> type Mat a = [[a]]
> :{
| primelem :: Mat a -> [a]
| primelem [] = []
| primelem [[x]] = [x]
| primelem ((x:xs):t) = x : primelem t
| :}
<interactive>:5:1: warning: [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In an equation for ‘primelem’: Patterns not matched: ([]:_)
<interactive>:7:14: warning: [-Wunused-matches]
Defined but not used: ‘xs’
So, the case you are missing is:
primelem ([]:t) = ...
You're over-thinking this. A list of empty lists is its own transpose.
transpose m | all null m = []
| any null m = error "Not a matrix"
Otherwise, take the first element of each list as the first row of the transpose, and transpose the remaining matrix as the rest of the transpose.
transpose m = map head m : transpose (map tail m)
This function is effectively total, failing only on those lists-of-lists that aren't actually matrices. The fact that it fails late on non-matrix values is a bit of a wart:
> transpose [[1,2], [3]]
[[1,3]*** Exception: Not a matrix
CallStack (from HasCallStack):
error, called at tmp.hs:3:28 in main:Main
If you want to handle invalid matrices a little more cleanly, return a Maybe (Mat a) instead.
transpose :: Mat a -> Maybe (Mat a)
transpose m | all null m = Just []
| any null m = Nothing
| otherwise = ((map head m):) <$> transpose (map tail m)

Haskell | Problems with turning Chars and Int to string.

New to Haskell:
Hi can't seem to figure this out.
What I am trying to do is take a string, turn it in to a [Int] (with map ord)
Change some numbers that fulfils something (in this case x mod 3 == 0).
afterwards I'd like to turn the unchanged numbers back to char, and changed numbers still numbers. Combine this into a string again..
This is my problem:
*Main> fromStringToList "hihello"
[104,105,104,101,108,108,111]
*Main> changeB3 [104,105,104,101,108,108,111]
"'h'210'h''e'216216222"
What I want is:
"h210he216216222"
I'm stuck figuring out how to use show and map to get this to work without the '_' from Char. Thanks.
My Code:
import Data.Char
fromStringToList :: String -> [Int]
fromStringToList "" = []
fromStringToList myString = map ord myString
{-
changeB3
PRE: True
POST: every Int that can be divided by 3 is multiplied by 2 and
kept as int, otherwise transformed to char
-}
changeB3 :: [Int] -> String
changeB3 [] = ""
changeB3 (x:xs)
| x `mod ` 3 == 0 = show map (x * 2 ) ++ changeB3 xs
|otherwise = map chr x ++ changeB3 xs
I will comment your code.
fromStringToList :: String -> [Int]
fromStringToList "" = []
fromStringToList myString = map ord myString
The second line is redundant: when myString is empty, map returns [] anyway. You should remove it.
changeB3 :: [Int] -> String
changeB3 [] = ""
changeB3 (x:xs)
| x `mod ` 3 == 0 = show map (x * 2 ) ++ changeB3 xs
|otherwise = map chr x ++ changeB3 xs
You seem to be confused here. You use a recursive function, but want to use map. You use either recursion or map here, not both.
Assuming you want to use map, you should start by defining how to handle a single Int.
changeB3Single :: Int -> String
changeB3Single x | x `mod` 3 == 0 = ...
| otherwise = ...
Then you map that over the whole list. A first attempt might be
changeB3 :: [Int] -> String
changeB3 xs = map changeB3Single xs -- type error!
but this won't work, since map here returns a list of strings, rather than a single string. We just need to concatenate them.
changeB3 xs = concat (map changeB3Single xs)
Indeed, concat (map ...) is so commonly found that it has its own function in the libraries:
changeB3 xs = concatMap changeB3Single xs
(One could make that pointfree, but there's no need to -- especially for a beginner.)

Implementation of a program in which characters of a string repeated certain times in haskell

This is a question from my homework thus tips would be much likely appreciated.
I am learning Haskell this semester and my first assignment requires me to write a function that inputs 2 string (string1 and string2) and returns a string that is composed of (the repeated) characters of first string string1 until a string of same length as string2 has been created.
I am only allowed to use the Prelude function length.
For example: take as string1 "Key" and my name "Ahmed" as string2 the function should return "KeyKe".
Here is what I've got so far:
makeString :: Int -> [a] -> [a]
makeString val (x:xs)
| val > 0 = x : makeString (val-1) xs
| otherwise = x:xs
Instead of directly giving it two strings i am giving it an integer value (since i can subtitute it for length later on), but this is giving me a runtime-error:
*Main> makeString 8 "ahmed"
"ahmed*** Exception: FirstScript.hs: (21,1)-(23,21) : Non-exhaustive patterns in function makeString
I think it might have something to do my list running out and becoming an empty list(?).
A little help would be much appreciated.
I think this code is enough to solve your problem:
extend :: String -> String -> String
extend src dst = extend' src src (length dst)
where
extend' :: String -> String -> Int -> String
extend' _ _ 0 = []
extend' [] src size = extend' src src size
extend' (x:xs) src size = x : extend' xs src (size - 1)
The extend' function will cycle the first string until is is consumed then will begin to consume it again.
You can also make it using take and cycle like functions:
repeatString :: String -> String
repeatString x = x ++ repeatString x
firstN :: Int -> String -> String
firstN 0 _ = []
firstN n (x:xs) = x : firstN ( n - 1 ) xs
extend :: String -> String -> String
extend src dst = firstN (length dst) (repeatString src)
or a more generic version
repeatString :: [a] -> [a]
repeatString x = x ++ repeatString x
firstN :: (Num n, Eq n ) => n -> [a] -> [a]
firstN 0 _ = []
firstN n (x:xs) = x : firstN ( n - 1 ) xs
extend :: [a] -> [b] -> [a]
extend _ [] = error "Empty target"
extend [] _ = error "Empty source"
extend src dst = firstN (length dst) (repeatString src)
which is capable of taking any type of lists:
>extend [1,2,3,4] "foo bar"
[1,2,3,4,1,2,3]
Like Carsten said, you should
handle the case when the list is empty
push the first element at the end of the list when you drop it.
return an empty list when n is 0 or lower
For example:
makeString :: Int -> [a] -> [a]
makeString _ [] = [] -- makeString 10 "" should return ""
makeString n (x:xs)
| n > 0 = x:makeString (n-1) (xs++[x])
| otherwise = [] -- makeString 0 "key" should return ""
trying this in ghci :
>makeString (length "Ahmed") "Key"
"KeyKe"
Note: This answer is written in literate Haskell. Save it as Filename.lhs and try it in GHCi.
I think that length is a red herring in this case. You can solve this solely with recursion and pattern matching, which will even work on very long lists. But first things first.
What type should our function have? We're taking two strings, and we will repeat the first string over and over again, which sounds like String -> String -> String. However, this "repeat over and over" thing isn't really unique to strings: you can do that with every kind of list, so we pick the following type:
> repeatFirst :: [a] -> [b] -> [a]
> repeatFirst as bs = go as bs
Ok, so far nothing fancy happened, right? We defined repeatFirst in terms of go, which is still missing. In go we want to exchange the items of bs with the corresponding items of as, so we already know a base case, namely what should happen if bs is empty:
> where go _ [] = []
What if bs isn't empty? In this case we want to use the right item from as. So we should traverse both at the same time:
> go (x:xs) (_:ys) = x : go xs ys
We're currently handling the following cases: empty second argument list, and non-empty lists. We still need to handle the empty first argument list:
> go [] ys =
What should happen in this case? Well, we need to start again with as. And indeed, this works:
> go as ys
Here's everything again at a single place:
repeatFirst :: [a] -> [b] -> [a]
repeatFirst as bs = go as bs
where go _ [] = []
go (x:xs) (_:ys) = x : go xs ys
go [] ys = go as ys
Note that you could use cycle, zipWith and const instead if you didn't have constraints:
repeatFirst :: [a] -> [b] -> [a]
repeatFirst = zipWith const . cycle
But that's probably for another question.

counting frequencies in a collection of bins

I need to count values inbetween values in a list i.e. [135,136,138,140] would count all the numbers between 135-136,136-138,138-140. with the input list [135.2,135.3,137,139] would out put[2,1,1] using type [Float] [Float] [Int]. So far I have:
heightbetween :: Float -> Float -> [Float] -> Int
heightbetween _ _ [] = 0
heightbetween n s (x:xs)
| (n < x) && (s > x) = 1 + (heightbetween n s xs)
| otherwise = heightbetween n s xs
count :: [Float] -> [Float] -> [Int]
count [] [] = []
count [x,y] = [(x,y)]
count (x:y:ys) = (x,y):count (y:ys)
forEach fun lst = heightbetween op ([],lst)
where
op (start,[]) = Nothing
op (start,a:as) = Just (start++(fun a):as
,(start++[a],as))
forPairs fun lst lst2 = map (map fst)
$ forEach (\(a,b)->(fun a b,b))
$ zip lst lst2
Your count looks strange. It should be like this:
-- count -> ranges -> data -> [counts]
count :: [Float] -> [Float] -> [Int]
count [] _ = [] -- no ranges given -> empty list
count [_] _ = [] -- no ranges, but single number -> empty list
count _ [] = [] -- no data given -> empty list
count (x:y:xs) d =
(heightbetween x y d) : count (y:xs) d
heightbetween :: Float -> Float -> [Float] -> Int
heightbetween _ _ [] = 0
heightbetween n s (x:xs)
| (n < x) && (s > x) = 1 + (heightbetween n s xs)
| otherwise = heightbetween n s xs
The other lines are obsolete.
Then invoking
count [135,136,138,140] [135.2,135.3,137,139]
gives
[2,1,1]
First, make sure that your range list is in order....
rangePoints = [135,136,138,140]
orderedRangePoints = sort rangePoints
Next, you will find it much easier to work with actual ranges (which you can represent using a 2-tuple (low,high))
ranges = zip orderedRangePoints $ tail orderedRangePoints
You will need an inRange function (one already exists in Data.Ix, but unfortunately it includes the upperbound, so you can't use it)
inRange (low,high) val | val >= low && val < high = True
inRange _ _ = False
You will also want to order your input points
theData = sort [135.2,135.3,137,139]
With all of this out of the way, the binCount function is easy to write.
binCount'::[(Float, Float)]->[Float]->[Int]
binCount' [] [] = []
binCount' (range:rest) vals =
length valsInRange:binCount' rest valsAboveRange
where
(valsInRange, valsAboveRange) = span (`inRange` range) vals
Notice, that I defined a function called binCount', not binCount. I did this, because I consider this an unsafe function, because it only works on ordered ranges and values.... You should finalize this by writing a safer binCount function, which puts all of the stuff above in its where clause. You should probably add all the types and some error checking also (what happens if a value is outside of all ranges?).

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