Making inits function in Haskell - haskell

Alright so here is an interesting situation (imo)
Here's my code:
tails' :: [a] -> [[a]]
tails' [] = []
tails' (x:xs) = tail (x:xs) : tails' xs
inits' :: [a] -> [[a]]
inits' [] = []
inits' (x:xs) = init(x:xs) : inits' xs
eightB :: (Eq a) => [a] -> [a] -> Bool
eightB xs ys = elem xs (tails' ys ++ inits' ys)
I'm trying to solve the "Needle in a Haystack" problem from Learn You a Haskell For Great Good; in my own way.
The problem I'm running into is, when I try inputting:
inits' [1,2,3,4,5]
into ghci, I get:
[[1,2,3,4],[2,3,4],[3,4],[4],[]]
The function works fine for the first iteration, but for some reason decides to switch to the tail function after the first iteration (at least that's what I think is happening).

#Iuqui helped me get to this answer.
inits' :: [a] -> [[a]]
inits' [] = []
inits' xs = init xs : inits' (init xs)

I know this is several years old, but figured I'd mention that inits' is not really useful for producing an implementation of the search/isInfixOf function. Your code above checks to see whether the needle is equal to one of the tails or one of the inits, not whether it's contained somewhere. Now if you actually do want to calculate your eightB function for some reason, you can do so much more cheaply:
eightB xs ys =
(xs `isPrefixOf'` ys)
|| (reverse xs `isPrefixOf'` reverse ys)
xs `isPrefixOf'` ys = and (zipWith (==) xs ys)

The problem is, there is a sort of inherent tail function in your pattern matching in inits'.
inits' (x:xs) = ....
This breaks up the list into two parts
x = head theList
xs = tail theList
When you recurse, you are only using the tail part
inits' (x:xs) = <stuff ....> : inits' xs
What you really want to do is pass the init of the list into the recursion. Unfortunately, you can't break up a list into init and last using pattern matching. You can do this easily in a where though.
This is probably what you want to do
inits' :: [a] -> [[a]]
inits' [] = []
inits' theList = i:inits' i
where
i = init theList

I just solved this for an assigment in uni: I think this a clean way to go about it. You can also write the helper function using map (put in comment above)
--add x xss = map (x :) xss
add :: a -> [[a]] -> [[a]]
add x [] = []
add x (xs:xss) = (x:xs) : add x xss
inits :: [a] -> [[a]]
inits [] = [[]]
inits (x:xs) = [] : add x (inits xs)
tails :: [a] -> [[a]]
tails [] = [[]]
tails (x:xs) = (x:xs) : tails xs

There is one huge problem with using init in inits, that is, init cannot return anything meaningful nor correct with an infinite list.
There are alternatives for inits
The simplest is
[ [1..i] | i <- [1..] ]
It will output forever. It is wise to use take with it.
Functions should approach total functions.
ins ls = [ take i ls | i <- [1..] ]
take 6 $ ins ['a'..]
["a","ab","abc","abcd","abcde","abcdef"]
These are infinite tails functions. The first, numbers only. The second, any.
> tlsn = [ replicate i i | i <- [1..] ]
> tls xs = [ replicate i x |(i,x) <- zip [1..] xs ]
> take 5 tlsn
[[1],[2,2],[3,3,3],[4,4,4,4],[5,5,5,5,5]]
This is tails and a transposition of tails, both from top to bottom
1 2 3 4 5 1
2 3 4 5 2 2
3 4 5 3 3 3
4 5 4 4 4 4
5 5 5 5 5 5
> transpose.take 5 $ tlsn
[[1,2,3,4,5],[2,3,4,5],[3,4,5],[4,5],[5]]
transpose will not transpose an infinite list.
What to do?

Related

Haskell Permutations with very limited functions

I have to implement a function in haskell that takes a list [Int] and gives a list [[Int]] with all permutations, but i'm only allowed to use:
[], :, True, False, comparisons, &&, ||, and not
permutations [] = [[]]
permutations xs = [(y:zs) | (y,ys) <- picks xs, zs <- permutations ys]
where
picks (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- picks xs]
My idea was to use something like that but i have to replace the <-
As mentioned by chepner in the comments, a few missing elementary library functions can easily be re-implemented “on the spot”.
The Wikipedia article on permutations leads us to, among many other things, the Steinhaus–Johnson–Trotter algorithm, which seems well suited to linked lists.
For this algorithm, an essential building block is a function we could declare as:
spread :: a -> [a] -> [[a]]
For example, expression spread 4 [1,2,3] has to put 4 at all possible positions within [1,2;3], thus evaluating to: [[4,1,2,3],[1,4,2,3],[1,2,4,3],[1,2,3,4]]. To get all permutations of [1,2,3,4], you just need to apply spread 4 to all permutations of [1,2,3]. And it is easy to write spread in recursive fashion:
spread :: a -> [a] -> [[a]]
spread x [] = [[x]]
spread x (y:ys) = (x:y:ys) : (map (y:) (spread x ys))
And permutations can thus be obtained like this:
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations (x:xs) = concat (map (spread x) (permutations xs))
Overall, a rules-compliant version of the source code would go like this, with its own local versions of the map and concat Prelude functions:
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations (x:xs) = myConcat (myMap (spread x) (permutations xs))
where
myMap fn [] = []
myMap fn (z:zs) = (fn z) : (myMap fn zs)
myConcat [] = []
myConcat ([]:zss) = myConcat zss
myConcat ((z:zs):zss) = z : (myConcat (zs:zss))
spread z [] = [[z]]
spread z (y:ys) = ( z:y:ys) : (myMap (y:) (spread z ys))

Haskell Error on program

just working on a problem and it keeps giving me this error:
Exception: Prelude.tail: empty list
Here is my code so far:
lxP :: Eq a => [[a]] -> [a]
lxP [] = []
lxP xss
| any null xss = []
| otherwise = loop xss []
where loop ::Eq b => [[b]] -> [b] -> [b]
loop xss acc =
let xs = concatMap (take 1) xss
in if any (\x -> x /= head xs) (tail xs)
then reverse acc
else loop (map tail xss) (head xs : acc)
Any idea if my indentation is the problem or is it something with the code?
PS. How could I improve the efficiency?
I can’t quite work out what your function is supposed to do. It doesn’t make sense to me as a reasonable thing to want. Here’s what it looks like to me:
You take some list of lists (let’s say it’s a matrix for now as I’m about to talk about columns) and you want to return the longest prefix of the first row such that each element is in a constant column.
So let’s try to write this in a more idiomatic way.
Now we want to look for constantness in columns, but what should we do if the rows aren’t the same length? I’m going to decide that we’ll just ignore them and imagine shoving all elements upwards so that there are no gaps. Let’s convert rows to columns:
transpose :: [[a]] -> [[a]]
transpose xss = t xss where
n = maximum (map length xss)
t [] = repeat n []
t (xs:xss) = join xs (t xss)
join [] yss = yss
join (x:xs) (ys:yss) = (x:ys) : join xs yss
So now we can write the function.
myWeirdFunction xss
| any null xss = []
| otherwise = map head $ takeWhile constant $ transpose xss where
constant (x:xs) = c x xs
c x (y:ys) | y == x = c x ys
| True = False
c x [] = True

interleaving two strings, preserving order: functional style

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 to recursively define my own haskell function for appending two lists?

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.

Merge sort in Haskell

I am new to Haskell and I am trying to implement a few known algorithms in it.
I have implemented merge sort on strings. I am a bit disappointed with the
performance of my Haskell implementation compared to C and Java implementations.
On my machine (Ubuntu Linux, 1.8 GHz), C (gcc 4.3.3) sorts 1 000 000 strings in 1.85 s,
Java (Java SE 1.6.0_14) in 3.68 s, Haskell (GHC 6.8.2) in 25.89 s.
With larger input (10 000 000 strings), C takes 21.81 s, Java takes 59.68 s, Haskell
starts swapping and I preferred to stop the program after several minutes.
Since I am new to Haskell, I would be interested to know if my implementation can
be made more time / space efficient.
Thank you in advance for any hint
Giorgio
My implementation:
merge :: [String] -> [String] -> [String]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = if x < y
then x : (merge xs (y:ys))
else y : (merge (x:xs) ys)
mergeSort :: [String] -> [String]
mergeSort xs = if (l < 2)
then xs
else merge h t
where l = length xs
n = l `div` 2
s = splitAt n xs
h = mergeSort (fst s)
t = mergeSort (snd s)
Try this version:
mergesort :: [String] -> [String]
mergesort = mergesort' . map wrap
mergesort' :: [[String]] -> [String]
mergesort' [] = []
mergesort' [xs] = xs
mergesort' xss = mergesort' (merge_pairs xss)
merge_pairs :: [[String]] -> [[String]]
merge_pairs [] = []
merge_pairs [xs] = [xs]
merge_pairs (xs:ys:xss) = merge xs ys : merge_pairs xss
merge :: [String] -> [String] -> [String]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
= if x > y
then y : merge (x:xs) ys
else x : merge xs (y:ys)
wrap :: String -> [String]
wrap x = [x]
Bad idea is splitting list first. Instead of it just make list of one member lists. Haskell is lazy, it will be done in right time.
Then merge pairs of lists until you have only one list.
In Haskell, a string is a lazy list of characters and has the same overhead as any other list. If I remember right from a talk I heard Simon Peyton Jones give in 2004, the space cost in GHC is 40 bytes per character. For an apples-to-apples comparation you probably should be sorting Data.ByteString, which is designed to give performance comparable to other languages.
Better way to split the list to avoid the issue CesarB points out:
split [] = ([], [])
split [x] = ([x], [])
split (x : y : rest) = (x : xs, y : ys)
where (xs, ys) = split rest
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs = merge (mergesort ys) (mergesort zs)
where (ys, zs) = split xs
EDIT: Fixed.
I am not sure if this is the cause of your problem, but remember that lists are a sequential data structure. In particular, both length xs and splitAt n xs will take an amount of time proportional to the length of the list (O(n)).
In C and Java, you are most probably using arrays, which take constant time for both operations (O(1)).
Edit: answering your question on how to make it more efficient, you can use arrays in Haskell too.

Resources