I am practicing some Haskell exam paper questions, and have come across the following
Define a Haskell function weaveHunks which takes an int and
two lists and weaves them together in hunks of the given size.
Be sure to declare its type signature.
Example:
weaveHunks 3 "abcdefghijklmno" "ABCDEFGHIJKLMNO"
=> "abcABCdefDEFghiGHIjklJKLmnoMNO"
I have found the following on Stack Overflow, which is just too weave two lists together but only in chunks of 1
weaveHunks :: [a] -> [a] -> [a]
weaveHunks xs [] = xs
weaveHunks [] ys = ys
weaveHunks (x:xs) (y:ys) = x : y : weaveHunks xs ys
I am having problems adjusting this to take chunks fo n size, I am very new to Haskell but this is what I have so far
weaveHunks :: Int -> [a] -> [a] -> [a]
weaveHunks n xs [] = xs
weaveHunks n [] ys = ys
weaveHunks n xs ys = (take n xs) : (take n ys) : weaveHunks n (drop n xs) (drop n ys)
I am getting an error on the last line
(Couldn't match type a' with[a]')
Is (drop n xs) not a list?
You're very close!
By using the : operator to prepend the hunks, you're expressing that take n xs is one element of the result list, take n ys the next, and so on. But actually in both cases it's multiple elements you're prepending. That's the [a] that should actually be just a.
The solution is to use the ++ operator instead, which prepends an entire list rather than just a single element.
This is the full solution as I'd write it:
weaveHunks :: Int -> [a] -> [a] -> [a]
weaveHunks _ xs [] = xs
weaveHunks _ [] ys = ys
weaveHunks n xs ys = xHunk ++ yHunk ++ weaveHunks n xRemain yRemain
where [(xHunk, xRemain), (yHunk, yRemain)] = splitAt n <$> [xs,ys]
As #leftaroundabout said, since your appending lists of type [a], you need to use ++ instead of :. With this in mind, your code would then look like this:
weaveHunks :: Int -> [a] -> [a] -> [a]
weaveHunks _ xs [] = xs
weaveHunks _ [] ys = ys
weaveHunks n xs ys = (take n xs) ++ (take n ys) ++ weaveHunks n (drop n xs) (drop n ys)
If your interested, you can also use library functions to do this task:
import Data.List.Split
weaveHunks :: Int -> [a] -> [a] -> [a]
weaveHunks n xs ys = concat $ zipWith (++) (chunksOf n xs) (chunksOf n ys)
Note: chunksOf is from Data.List.Split, which splits the list into sublists of length n, so the type of this function is Int -> [a] -> [[a]]. zipWith zips two lists based on a condition, in this case concatenation ++. concat turns a list of [[a]] into [a].
Related
So I'm trying to write a function that, given two lists of integers, adds the ith even number of each list and returns them in another list. In case one of the list doesn't have an ith even number, a 0 is considered. For example, if the lists are [1,2,1,4,6] and [2,2], it returns [4,6,6] ([2+2,4+2,6+0]). I have the following code:
addEven :: [Int] -> [Int] -> [Int]
addEeven [] [] = []
addEeven (x:xs) [] = filter (\g -> g `mod`2 == 0) (x:xs)
addEven [] (y:ys) = filter (\g -> g `mod` 2 == 0) (y:ys)
addEven (x:xs) (y:ys) = (a + b):(addEven as bs)
where
(a:as) = filter (\g -> g `mod` 2 == 0) (x:xs)
(b:bs) = filter (\g -> g `mod` 2 == 0) (y:ys)
When I run that with the previous example, I get:
[4,6*** Exception: ex.hs:(4,1)-(8,101): Non-exhaustive patterns in function addEven
I really can't see what I'm missing, since it doesn't work with any input I throw at it.
A filter might eliminate elements, hence filter (\g -> gmod2 == 0) is not said to return any elements, and thus the patterns (a:as) and (b:bs) might fail.
That being said, I think you make the problem too complex here. You can first define a helper function that adds two elements of a list:
addList :: Num a => [a] -> [a] -> [a]
addList (x:xs) (y:ys) = (x+y) : addList xs ys
addList xs [] = xs
addList [] ys = ys
Then we do the filter on the two parameters, and make a function addEven that looks like:
addEven :: Integral a => [a] -> [a] -> [a]
addEven xs ys = addList (filter even xs) (filter even ys)
or with on :: (b -> b -> c) -> (a -> b) -> a -> a -> c:
import Data.Function(on)
addEven :: Integral a => [a] -> [a] -> [a]
addEven = addList `on` filter even
While using filter is very instinctive in this case, perhaps using filter twice and then summing up the results might be slightly ineffficient for large lists. Why don't we do the job all at once for a change..?
addMatches :: [Int] -> [Int] -> [Int]
addMatches [] [] = []
addMatches [] ys = filter even ys
addMatches xs [] = filter even xs
addMatches xs ys = first [] xs ys
where
first :: [Int] -> [Int] -> [Int] -> [Int]
first rs [] ys = rs ++ filter even ys
first rs (x:xs) ys = rs ++ if even x then second [x] xs ys
else first [] xs ys
second :: [Int] -> [Int] -> [Int] -> [Int]
second [r] xs [] = [r] ++ filter even xs
second [r] xs (y:ys) = if even y then first [r+y] xs ys
else second [r] xs ys
λ> addMatches [1,2,1,4,6] [2,2]
[4,6,6]
In this question, the author brings up an interesting programming question: given two string, find possible 'interleaved' permutations of those that preserves order of original strings.
I generalized the problem to n strings instead of 2 in OP's case, and came up with:
-- charCandidate is a function that finds possible character from given strings.
-- input : list of strings
-- output : a list of tuple, whose first value holds a character
-- and second value holds the rest of strings with that character removed
-- i.e ["ab", "cd"] -> [('a', ["b", "cd"])] ..
charCandidate xs = charCandidate' xs []
charCandidate' :: [String] -> [String] -> [(Char, [String])]
charCandidate' [] _ = []
charCandidate' ([]:xs) prev =
charCandidate' xs prev
charCandidate' (x#(c:rest):xs) prev =
(c, prev ++ [rest] ++ xs) : charCandidate' xs (x:prev)
interleavings :: [String] -> [String]
interleavings xs = interleavings' xs []
-- interleavings is a function that repeatedly applies 'charCandidate' function, to consume
-- the tuple and build permutations.
-- stops looping if there is no more tuple from charCandidate.
interleavings' :: [String] -> String -> [String]
interleavings' xs prev =
let candidates = charCandidate xs
in case candidates of
[] -> [prev]
_ -> concat . map (\(char, ys) -> interleavings' ys (prev ++ [char])) $ candidates
-- test case
input :: [String]
input = ["ab", "cd"]
-- interleavings input == ["abcd","acbd","acdb","cabd","cadb","cdab"]
it works, however I'm quite concerned with the code:
it is ugly. no point-free!
explicit recursion and additional function argument prev to preserve states
using tuples as intermediate form
How can I rewrite the above program to be more "haskellic", concise, readable and more conforming to "functional programming"?
I think I would write it this way. The main idea is to treat creating an interleaving as a nondeterministic process which chooses one of the input strings to start the interleaving and recurses.
Before we start, it will help to have a utility function that I have used countless times. It gives a convenient way to choose an element from a list and know which element it was. This is a bit like your charCandidate', except that it operates on a single list at a time (and is consequently more widely applicable).
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go xs [] = []
go xs (y:ys) = (xs, y, ys) : go (y:xs) ys
With that in hand, it is easy to make some non-deterministic choices using the list monad. Notionally, our interleavings function should probably have a type like [NonEmpty a] -> [[a]] which promises that each incoming string has at least one character in it, but the syntactic overhead of NonEmpty is too annoying for a simple exercise like this, so we'll just give wrong answers when this precondition is violated. You could also consider making this a helper function and filtering out empty lists from your top-level function before running this.
interleavings :: [[a]] -> [[a]]
interleavings [] = [[]]
interleavings xss = do
(xssL, h:xs, xssR) <- zippers xss
t <- interleavings ([xs | not (null xs)] ++ xssL ++ xssR)
return (h:t)
You can see it go in ghci:
> interleavings ["abc", "123"]
["abc123","ab123c","ab12c3","ab1c23","a123bc","a12bc3","a12b3c","a1bc23","a1b23c","a1b2c3","123abc","12abc3","12ab3c","12a3bc","1abc23","1ab23c","1ab2c3","1a23bc","1a2bc3","1a2b3c"]
> interleavings ["a", "b", "c"]
["abc","acb","bac","bca","cba","cab"]
> permutations "abc" -- just for fun, to compare
["abc","bac","cba","bca","cab","acb"]
This is fastest implementation I've come up with so far. It interleaves a list of lists pairwise.
interleavings :: [[a]] -> [[a]]
interleavings = foldr (concatMap . interleave2) [[]]
This horribly ugly mess is the best way I could find to interleave two lists. It's intended to be asymptotically optimal (which I believe it is); it's not very pretty. The constant factors could be improved by using a special-purpose queue (such as the one used in Data.List to implement inits) rather than sequences, but I don't feel like including that much boilerplate.
{-# LANGUAGE BangPatterns #-}
import Data.Monoid
import Data.Foldable (toList)
import Data.Sequence (Seq, (|>))
interleave2 :: [a] -> [a] -> [[a]]
interleave2 xs ys = interleave2' mempty xs ys []
interleave2' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]]
interleave2' !prefix xs ys rest =
(toList prefix ++ xs ++ ys)
: interleave2'' prefix xs ys rest
interleave2'' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]]
interleave2'' !prefix [] _ = id
interleave2'' !prefix _ [] = id
interleave2'' !prefix xs#(x : xs') ys#(y : ys') =
interleave2' (prefix |> y) xs ys' .
interleave2'' (prefix |> x) xs' ys
Using foldr over interleave2
interleave :: [[a]] -> [[a]]
interleave = foldr ((concat .) . map . iL2) [[]] where
iL2 [] ys = [ys]
iL2 xs [] = [xs]
iL2 (x:xs) (y:ys) = map (x:) (iL2 xs (y:ys)) ++ map (y:) (iL2 (x:xs) ys)
Another approach would be to use the list monad:
interleavings xs ys = interl xs ys ++ interl ys xs where
interl [] ys = [ys]
interl xs [] = [xs]
interl xs ys = do
i <- [1..(length xs)]
let (h, t) = splitAt i xs
map (h ++) (interl ys t)
So the recursive part will alternate between the two lists, taking all from 1 to N elements from each list in turns and then produce all possible combinations of that. Fun use of the list monad.
Edit: Fixed bug causing duplicates
Edit: Answer to dfeuer. It turned out tricky to do code in the comment field. An example of solutions that do not use length could look something like:
interleavings xs ys = interl xs ys ++ interl ys xs where
interl [] ys = [ys]
interl xs [] = [xs]
interl xs ys = splits xs >>= \(h, t) -> map (h ++) (interl ys t)
splits [] = []
splits (x:xs) = ([x], xs) : map ((h, t) -> (x:h, t)) (splits xs)
The splits function feels a bit awkward. It could be replaced by use of takeWhile or break in combination with splitAt, but that solution ended up a bit awkward as well. Do you have any suggestions?
(I got rid of the do notation just to make it slightly shorter)
Combining the best ideas from the existing answers and adding some of my own:
import Control.Monad
interleave [] ys = return ys
interleave xs [] = return xs
interleave (x : xs) (y : ys) =
fmap (x :) (interleave xs (y : ys)) `mplus` fmap (y :) (interleave (x : xs) ys)
interleavings :: MonadPlus m => [[a]] -> m [a]
interleavings = foldM interleave []
This is not the fastest possible you can get, but it should be good in terms of general and simple.
How would I define an append function that takes two lists and output 1 list.
So plusplus [1,2,3] [4,5,6] should return [1,2,3,4,5,6].
I have the following so far:
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] [] = []
plusplus [] [x] = [x]
plusplus [x] [] = [x]
plusplus (x:xs) (y:ys) = x: plusplus xs (y:ys)
I want to define my own ++ function, but with recursion. The code above gives an error when I actually execute it with two lists.
This is an example of an error I get with the command:
plusplus [1,2,3] [4,5,6]
[1,2,3*** Exception: baby.hs:(...): Non-exhaustive patterns in function plusplus
ok basically the only problem you have here is a missing case:
pluspluse (x:xs) [] = ...
is missing (and will cause an error)
but you can clean up quite a bit:
The first two cases are basically the same: whatever the second input is will be the result - so you can just it those a name (say ys) and write:
plusplus [] ys = ys
(can you see how this includes your first two cases? - what is ys in those?)
your 3rd line one will be covered by the correct last case (see below) - to see this remember that [x] == x:[]
I'll give you the complete answer in a few minutes - but you should try to figure it out:
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] ys = ys
plusplus (x:xs) ? = ??
try to find the correct things to replace ? and ?? with
you almost had it - and the answer can be:
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] ys = ys
plusplus (x:xs) ys = x: plusplus xs ys
as you can see you never have to touch the second list - but need to recreate all of the first list (to link to the second)
We know that plusplus = flip (foldr (:)). Here's the definition of foldr:
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr step = let fold acc [] = acc
fold acc (x:xs) = step x (fold acc xs)
in fold
On specializing, we get:
foldr :: (a -> b -> b) -> b -> [a] -> b
| | | | | |
| | | | | |
(:) :: (a -> [a] -> [a]) | | |
| | |
foldr (:) :: [a] -> [a] -> [a]
Here's the definition of the specialized function:
fold :: [a] -> [a] -> [a]
fold acc [] = acc
fold acc (x:xs) = x : fold acc xs
Ofcourse, we need to flip the arguments:
plusplus :: [a] -> [a] -> [a]
plusplus [] ys = ys
plusplus (x:xs) ys = x : plusplus xs ys
That's the reason why plusplus is defined the way it is.
Thanks guys! With the help of Carsten spotting my silly mistake.
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] [] = []
plusplus (x:xs) [] = x:xs
plusplus [] (x:xs) = x:xs
plusplus (x:xs) (y:ys) = x: plusplus xs (y:ys)
This works.
So for input:
plusplus [1,2,3] [4,5,6]
Output is:
[1,2,3,4,5,6]
This is really a riff on Carsten's answer, but I think it's worth going into and won't fit into a comment. One of the keys to avoiding non-exhaustive pattern errors in function definitions is to approach writing functions in a more mechanical, formulaic manner. The definition of the list type is something like this:
data [a] = [] | a : [a]
So list types have two data constructors, [] and :. So a good first thing to try when starting your function is to write two equations, one for each of the constructors. Carsten's template (which I'm mostly copying now) is following that pattern:
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] ys = _ -- Equation for empty list
plusplus (x:xs) ys = _ -- Equation for list cells
Now since we've written one pattern for each of the constructors of the type, we're now guaranteed that our patterns are exhaustive. So we stare at what we got a bit, and now we see the solution:
plusplus :: [Int] -> [Int] -> [Int]
plusplus [] ys = ys
plusplus (x:xs) ys = x : plusplus xs ys
Let's try another one! Signature:
-- | Merge two lists by alternating elements of one with the
-- other. After either list runs out, just continue with the
-- remaining elements of the other.
interleave :: [a] -> [a] -> [a]
interleave xs ys = _
Let's expand this to two equations by splitting the xs variable according to the two constructors, and fill in the easy parts on the right hand side:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys -- this one was easy
interleave (x:xs) ys = x : _ -- we know it has to start with `x`
Now we can go two ways. The first one is we could take the second equation and split it into two cases for ys:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) [] = x : _
interleave (x:xs) (y:ys) = x : _
And filling in those blanks is easy:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) [] = x : xs
interleave (x:xs) (y:ys) = x : y : interleave xs ys
The second way is, instead of splitting ys on the constructors' cases, to notice that this works:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs
So by going about it systematically based on the constructors we know for sure that all combinations are covered.
here's my question:
How to extract the same elements from two equal length lists to another list?
For example: given two lists [2,4,6,3,2,1,3,5] and [7,3,3,2,8,8,9,1] the answer should be [1,2,3,3]. Note that the order is immaterial. I'm actually using the length of the return list.
I tried this:
sameElem as bs = length (nub (intersect as bs))
but the problem is nub removes all the duplications. The result of using my function to the former example is 3 the length of [1,3,2] instead of 4 the length of [1,3,3,2]. Is there a solution? Thank you.
Since the position seems to be irrelevant, you can simply sort the lists beforehand and then traverse both lists:
import Data.List (sort)
intersectSorted :: Ord a => [a] -> [a] -> [a]
intersectSorted (x:xs) (y:ys)
| x == y = x : intersectSorted xs ys
| x < y = intersectSorted xs (y:ys)
| x > y = intersectSorted (x:xs) ys
intersectSorted _ _ = []
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = intersectSorted (sort xs) (sort ys)
Note that it's also possible to achieve this with a Map:
import Data.Map.Strict (fromListWith, assocs, intersectionWith, Map)
type Counter a = Map a Int
toCounter :: Ord a => [a] -> Counter a
toCounter = fromListWith (+) . flip zip (repeat 1)
intersectCounter :: Ord a => Counter a -> Counter a -> Counter a
intersectCounter = intersectionWith min
toList :: Counter a -> [a]
toList = concatMap (\(k,c) -> replicate c k) . assocs
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = toList $ intersectCounter (toCounter xs) (toCounter ys)
You could write a function for this. There is probably a more elegant version of this involving lambda's or folds, but this does work for your example:
import Data.List
same (x:xs) ys = if x `elem` ys
then x:same xs (delete x ys)
else same xs ys
same [] _ = []
same _ [] = []
The delete x ys in the then-clause is important, without that delete command items from the first list that occur at least once will be counted every time they're encountered.
Note that the output is not sorted, since you were only interested in the length of the resulting list.
import Data.List (delete)
mutuals :: Eq a => [a] -> [a] -> [a]
mutuals [] _ = []
mutuals (x : xs) ys | x `elem` ys = x : mutuals xs (delete x ys)
| otherwise = mutuals xs ys
gives
mutuals [2,4,6,3,2,1,3,5] [7,3,3,2,8,8,9,1] == [2,3,1,3]
I have implemented two versions of Merge Sort in Haskell like follows:
mergeSort1 :: (Ord a) => [a] -> [a]
mergeSort1 xs = foldl' (\acc x -> merge [x] acc) [] xs
and
mergeSort2 :: (Ord a) => [a] -> [a]
mergeSort2 [] = []
mergeSort2 (x:[]) = [x]
mergeSort2 xs = (mergeSort2 $ fst halves) `merge` (mergeSort2 $ snd halves)
where halves = splitList xs
where 'merge' and 'splitList' are implemented as follows:
merge :: (Ord a) => [a] -> [a] -> [a]
merge [] [] = []
merge xs [] = xs
merge [] ys = ys
merge all_x#(x:xs) all_y#(y:ys)
| x < y = x:merge xs all_y
| otherwise = y:merge all_x ys
splitList :: [a] -> ([a], [a])
splitList zs = go zs [] [] where
go [] xs ys = (xs, ys)
go [x] xs ys = (x:xs, ys)
go (x:y:zs) xs ys = go zs (x:xs) (y:ys)
Doing last $ mergeSort2 [1000000,999999..0] in ghci results in showing the number 1000000 after more than a minute of processing, while doing last $ mergeSort1 [1000000,999999..0] results in showing the last element only after 5 seconds.
I can understand why mergeSort1 uses much less memory than mergeSort2 because of the tail-recursiveness of foldl' and so.
What I can't understand is why mergeSort1 is faster than mergeSort2 by such a big difference ?
Could it be that splitList is the bottleneck in mergeSort2, generating two new lists every call?
As is,
mergeSort2 :: (Ord a) => [a] -> [a]
mergeSort2 xs = (mergeSort2 $ fst halves) `merge` (mergeSort2 $ snd halves)
where halves = splitList xs
is an infinite recursion, since you haven't given a base case (you need to specify the result for lists of length < 2). After that is fixed, mergeSort2 is still relatively slow due to the splitList which requires a complete traversal in each step and builds two new lists, not allowing to process anything before that is completed. A simple
splitList zs = splitAt h zs where h = length zs `quot` 2
does much better.
Your mergeSort1, however, is not a merge sort at all, it is an insertion sort.
mergeSort1 :: (Ord a) => [a] -> [a]
mergeSort1 xs = foldl' (\acc x -> merge [x] acc) [] xs
That does particularly well on reverse-sorted input, but if you give it sorted or random input, it scales quadratically.
So mergeSort1 was faster because you gave it optimal input, where it finishes in linear time.