Haskell Permutations with very limited functions - haskell

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

Related

Split a list into non-empty sub-lists in Haskell

I have to split the given list into non-empty sub-lists each of which
is either in strictly ascending order, in strictly descending order, or contains all equal elements. For example, [5,6,7,2,1,1,1] should become [[5,6,7],[2,1],[1,1]].
Here is what I have done so far:
splitSort :: Ord a => [a] -> [[a]]
splitSort ns = foldr k [] ns
where
k a [] = [[a]]
k a ns'#(y:ys) | a <= head y = (a:y):ys
| otherwise = [a]:ns'
I think I am quite close but when I use it it outputs [[5,6,7],[2],[1,1,1]] instead of [[5,6,7],[2,1],[1,1]].
Here is a kinda ugly solution, with three reverse in one line of code :).
addElement :: Ord a => a -> [[a]] -> [[a]]
addElement a [] = [[a]]
addElement a (x:xss) = case x of
(x1:x2:xs)
| any (check a x1 x2) [(==),(<),(>)] -> (a:x1:x2:xs):xss
| otherwise -> [a]:(x:xss)
_ -> (a:x):xss
where
check x1 x2 x3 op = (x1 `op` x2) && (x2 `op` x3)
splitSort xs = reverse $ map reverse $ foldr addElement [] (reverse xs)
You can possibly get rid of all the reversing if you modify addElement a bit.
EDIT:
Here is a less reversing version (even works for infinite lists):
splitSort2 [] = []
splitSort2 [x] = [[x]]
splitSort2 (x:y:xys) = (x:y:map snd here):splitSort2 (map snd later)
where
(here,later) = span ((==c) . uncurry compare) (zip (y:xys) xys)
c = compare x y
EDIT 2:
Finally, here is a solution based on a single decorating/undecorating, that avoids comparing any two values more than once and is probably a lot more efficient.
splitSort xs = go (decorate xs) where
decorate :: Ord a => [a] -> [(Ordering,a)]
decorate xs = zipWith (\x y -> (compare x y,y)) (undefined:xs) xs
go :: [(Ordering,a)] -> [[a]]
go ((_,x):(c,y):xys) = let (here, later) = span ((==c) . fst) xys in
(x : y : map snd here) : go later
go xs = map (return . snd) xs -- Deal with both base cases
Every ordered prefix is already in some order, and you don't care in which, as long as it is the longest:
import Data.List (group, unfoldr)
foo :: Ord t => [t] -> [[t]]
foo = unfoldr f
where
f [] = Nothing
f [x] = Just ([x], [])
f xs = Just $ splitAt (length g + 1) xs
where
(g : _) = group $ zipWith compare xs (tail xs)
length can be fused in to make the splitAt count in unary essentially, and thus not be as strict (unnecessarily, as Jonas Duregård rightly commented):
....
f xs = Just $ foldr c z g xs
where
(g : _) = group $ zipWith compare xs (tail xs)
c _ r (x:xs) = let { (a,b) = r xs } in (x:a, b)
z (x:xs) = ([x], xs)
The initial try turned out to be lengthy probably inefficient but i will keep it striked for the sake of integrity with the comments. You best just skip to the end for the answer.
Nice question... but turns out to be a little hard candy. My approach is in segments, those of each i will explain;
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort (x:xs) = (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) . tuples $ (x:xs)
interim = groups >>= return . map fst
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
The pattern function (zipWith compare <$> init <*> tail) is of type Ord a => [a] -> [Ordering] when fed with [5,6,7,2,1,1,1] compares the init of it by the tail of it by zipWith. So the result would be [LT,LT,GT,GT,EQ,EQ]. This is the pattern we need.
The tuples function will take the tail of our list and will tuple up it's elements with the corresponding elements from the result of pattern. So we will end up with something like [(6,LT),(7,LT),(2,GT),(1,GT),(1,EQ),(1,EQ)].
The groups function utilizes Data.List.groupBy over the second items of the tuples and generates the required sublists such as [[(6,LT),(7,LT)],[(2,GT),(1,GT)],[(1,EQ),(1,EQ)]]
Interim is where we monadically get rid of the Ordering type values and tuples. The result of interim is [[6,7],[2,1],[1,1]].
Finally at the main function body (:) <$> (x :) . head <*> tail $ interim appends the first item of our list (x) to the sublist at head (it has to be there whatever the case) and gloriously present the solution.
Edit: So investigating the [0,1,0,1] resulting [[0,1],[0],[1]] problem that #Jonas Duregård discovered, we can conclude that in the result there shall be no sub lists with a length of 1 except for the last one when singled out. I mean for an input like [0,1,0,1,0,1,0] the above code produces [[0,1],[0],[1],[0],[1],[0]] while it should [[0,1],[0,1],[0,1],[0]]. So I believe adding a squeeze function at the very last stage should correct the logic.
import Data.List (groupBy)
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort [x] = [[x]]
splitSort (x:xs) = squeeze $ (:) <$> (x :) . head <*> tail $ interim
where
pattern = zipWith compare <$> init <*> tail
tuples = zipWith (,) <$> tail <*> pattern
groups = groupBy (\p c -> snd p == snd c) $ tuples (x:xs)
interim = groups >>= return . map fst
squeeze [] = []
squeeze [y] = [y]
squeeze ([n]:[m]:ys) = [n,m] : squeeze ys
squeeze ([n]:(m1:m2:ms):ys) | compare n m1 == compare m1 m2 = (n:m1:m2:ms) : squeeze ys
| otherwise = [n] : (m1:m2:ms) : squeeze ys
squeeze (y:ys) = y : squeeze s
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
Yes; as you will also agree the code has turned out to be a little too lengthy and possibly not so efficient.
The Answer: I have to trust the back of my head when it keeps telling me i am not on the right track. Sometimes, like in this case, the problem reduces down to a single if then else instruction, much simpler than i had initially anticipated.
runner :: Ord a => Maybe Ordering -> [a] -> [[a]]
runner _ [] = []
runner _ [p] = [[p]]
runner mo (p:q:rs) = let mo' = Just (compare p q)
(s:ss) = runner mo' (q:rs)
in if mo == mo' || mo == Nothing then (p:s):ss
else [p] : runner Nothing (q:rs)
splitSort :: Ord a => [a] -> [[a]]
splitSort = runner Nothing
My test cases
*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
*Main> splitSort [1,2,3,5,2,0,0,0,-1,-1,0]
[[1,2,3,5],[2,0],[0,0],[-1,-1],[0]]
For this solution I am making the assumption that you want the "longest rally". By that I mean:
splitSort [0, 1, 0, 1] = [[0,1], [0,1]] -- This is OK
splitSort [0, 1, 0, 1] = [[0,1], [0], [1]] -- This is not OK despite of fitting your requirements
Essentially, There are two pieces:
Firstly, split the list in two parts: (a, b). Part a is the longest rally considering the order of the two first elements. Part b is the rest of the list.
Secondly, apply splitSort on b and put all list into one list of list
Taking the longest rally is surprisingly messy but straight. Given the list x:y:xs: by construction x and y will belong to the rally. The elements in xs belonging to the rally depends on whether or not they follow the Ordering of x and y. To check this point, you zip every element with the Ordering is has compared against its previous element and split the list when the Ordering changes. (edge cases are pattern matched) In code:
import Data.List
import Data.Function
-- This function split the list in two (Longest Rally, Rest of the list)
splitSort' :: Ord a => [a] -> ([a], [a])
splitSort' [] = ([], [])
splitSort' (x:[]) = ([x],[])
splitSort' l#(x:y:xs) = case span ( (o ==) . snd) $ zip (y:xs) relativeOrder of
(f, s) -> (x:map fst f, map fst s)
where relativeOrder = zipWith compare (y:xs) l
o = compare y x
-- This applies the previous recursively
splitSort :: Ord a => [a] -> [[a]]
splitSort [] = []
splitSort (x:[]) = [[x]]
splitSort (x:y:[]) = [[x,y]]
splitSort l#(x:y:xs) = fst sl:splitSort (snd sl)
where sl = splitSort' l
I wonder whether this question can be solve using foldr if splits and groups a list from
[5,6,7,2,1,1,1]
to
[[5,6,7],[2,1],[1,1]]
instead of
[[5,6,7],[2],[1,1,1]]
The problem is in each step of foldr, we only know the sorted sub-list on right-hand side and a number to be processed. e.g. after read [1,1] of [5,6,7,2,1,1,1] and next step, we have
1, [[1, 1]]
There are no enough information to determine whether make a new group of 1 or group 1 to [[1,1]]
And therefore, we may construct required sorted sub-lists by reading elements of list from left to right, and why foldl to be used. Here is a solution without optimization of speed.
EDIT:
As the problems that #Jonas Duregård pointed out on comment, some redundant code has been removed, and beware that it is not a efficient solution.
splitSort::Ord a=>[a]->[[a]]
splitSort numList = foldl step [] numList
where step [] n = [[n]]
step sublists n = groupSublist (init sublists) (last sublists) n
groupSublist sublists [n1] n2 = sublists ++ [[n1, n2]]
groupSublist sublists sortedList#(n1:n2:ns) n3
| isEqual n1 n2 = groupIf (isEqual n2 n3) sortedList n3
| isAscen n1 n2 = groupIfNull isAscen sortedList n3
| isDesce n1 n2 = groupIfNull isDesce sortedList n3
| otherwise = mkNewGroup sortedList n3
where groupIfNull check sublist#(n1:n2:ns) n3
| null ns = groupIf (check n2 n3) [n1, n2] n3
| otherwise = groupIf (check (last ns) n3) sublist n3
groupIf isGroup | isGroup = addToGroup
| otherwise = mkNewGroup
addToGroup gp n = sublists ++ [(gp ++ [n])]
mkNewGroup gp n = sublists ++ [gp] ++ [[n]]
isEqual x y = x == y
isAscen x y = x < y
isDesce x y = x > y
My initial thought looks like:
ordruns :: Ord a => [a] -> [[a]]
ordruns = foldr extend []
where
extend a [ ] = [ [a] ]
extend a ( [b] : runs) = [a,b] : runs
extend a (run#(b:c:etc) : runs)
| compare a b == compare b c = (a:run) : runs
| otherwise = [a] : run : runs
This eagerly fills from the right, while maintaining the Ordering in all neighbouring pairs for each sublist. Thus only the first result can end up with a single item in it.
The thought process is this: an Ordering describes the three types of subsequence we're looking for: ascending LT, equal EQ or descending GT. Keeping it the same every time we add on another item means it will match throughout the subsequence. So we know we need to start a new run whenever the Ordering does not match. Furthermore, it's impossible to compare 0 or 1 items, so every run we create contains at least 1 and if there's only 1 we do add the new item.
We could add more rules, such as a preference for filling left or right. A reasonable optimization is to store the ordering for a sequence instead of comparing the leading two items twice per item. And we could also use more expressive types. I also think this version is inefficient (and inapplicable to infinite lists) due to the way it collects from the right; that was mostly so I could use cons (:) to build the lists.
Second thought: I could collect the lists from the left using plain recursion.
ordruns :: Ord a => [a] -> [[a]]
ordruns [] = []
ordruns [a] = [[a]]
ordruns (a1:a2:as) = run:runs
where
runs = ordruns rest
order = compare a1 a2
run = a1:a2:runcontinuation
(runcontinuation, rest) = collectrun a2 order as
collectrun _ _ [] = ([], [])
collectrun last order (a:as)
| order == compare last a =
let (more,rest) = collectrun a order as
in (a:more, rest)
| otherwise = ([], a:as)
More exercises. What if we build the list of comparisons just once, for use in grouping?
import Data.List
ordruns3 [] = []
ordruns3 [a] = [[a]]
ordruns3 xs = unfoldr collectrun marked
where
pairOrder = zipWith compare xs (tail xs)
marked = zip (head pairOrder : pairOrder) xs
collectrun [] = Nothing
collectrun ((o,x):xs) = Just (x:map snd markedgroup, rest)
where (markedgroup, rest) = span ((o==).fst) xs
And then there's the part where there's a groupBy :: (a -> a -> Bool) -> [a] -> [[a]] but no groupOn :: Eq b => (a -> b) -> [a] -> [[a]]. We can use a wrapper type to handle that.
import Data.List
data Grouped t = Grouped Ordering t
instance Eq (Grouped t) where
(Grouped o1 _) == (Grouped o2 _) = o1 == o2
ordruns4 [] = []
ordruns4 [a] = [[a]]
ordruns4 xs = unmarked
where
pairOrder = zipWith compare xs (tail xs)
marked = group $ zipWith Grouped (head pairOrder : pairOrder) xs
unmarked = map (map (\(Grouped _ t) -> t)) marked
Of course, the wrapper type's test can be converted into a function to use groupBy instead:
import Data.List
ordruns5 [] = []
ordruns5 [a] = [[a]]
ordruns5 xs = map (map snd) marked
where
pairOrder = zipWith compare xs (tail xs)
marked = groupBy (\a b -> fst a == fst b) $
zip (head pairOrder : pairOrder) xs
These marking versions arrive at the same decoration concept Jonas Duregård applied.

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.

Haskell - How can I make this lists into tuple function pair with all elements?

So i have
pair:: [a] -> [b] -> [(a,b)]
pair[] _ = []
pair(x:xs) (y:ys) = (x, y) : prod xs ys
But the result are only like the following:
>> pair [1,2] [3,4]
>> [(1,3),(2,4)]
How can I make this so it pairs like:
[(1,3),(1,4),(2,3),(2,4)]
You can use the list applicative (or monad) instance:
λ> liftA2 (,) [1,2] [3,4]
[(1,3),(1,4),(2,3),(2,4)]
Or, equivalently,
f = do
x <- [1,2]
y <- [3,4]
return (x,y)
You can also use a list comprehension:
[ (x,y) | x <- [1,3], y <- [2,4] ]
Although there is already a much more elegant answer, i think it is worthwhile to show how this would be achieved in a simple straightforward way. If you want to get all pairs, you obviously need to visit every element of one list for an element in the other.
pair :: [a] -> [b] -> [(a, b)]
pair [] _ = []
pair (x:xs) ys = pair' x ys ++ pair xs ys where
pair' :: a -> [b] -> [(a, b)]
pair' _ [] = []
pair' x (y:ys) = (x,y) : pair' x ys
But of course using the pair = liftA2 (,) or [1,3] >>= \x -> [2,4] >>= \y -> (x,y) in its do notation or list comprehension notation is much better. Also ++ isn't what you normally want to do. So maybe you can build the lists as pair' would do, keep them in a list and then concat them.
concat $ map (\x -> map (\y -> (x,y)) ys) xs

How to consider previous elements when mapping over a list?

I'm stuck at making a function in Haskell wich has to do the following:
For each integer in a list check how many integers in front of it are smaller.
smallerOnes [1,2,3,5] will have the result [(1,0), (2,1), (3,2), (5,3)]
At the moment I have:
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes [] = []
smallerOnes (x:xs) =
I don't have any clue on how to tackle this problem. Recursion is probably the way of thinking here but at that point I'm losing it.
It is beneficial here not to start with a base case, but rather with a main case.
Imagine we've already processed half the list. Now we are faced with the rest of the list, say x:xs. We want to know how many integers "before it" are smaller than x; so we need to know these elements, say ys: length [y | y<-ys, y<x] will be the answer.
So you'll need to use an internal function that will maintain the prefix ys, produce the result for each x and return them in a list:
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes [] = []
smallerOnes xs = go [] xs
where
go ys (x:xs) = <result for this x> : <recursive call with updated args>
go ys [] = []
This can also be coded using some built-in higher-order functions, e.g.
scanl :: (a -> b -> a) -> a -> [b] -> [a]
which will need some post-processing (like map snd or something) or more directly with
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumL is in Data.List.
import Data.List (inits)
smallerOnes :: [Int] -> [(Int,Int)]
smallerOnes xs = zipWith (\x ys -> (x, length $ filter (< x) ys)) xs (inits xs)

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