How can I optimize this shuffle function? - haskell

I am trying to create a generic (type-o-polymophism?) shuffle function with Haskell. I needs to sort a couple of thousand elements in a fraction of a second to be deemed "good enough".
evens :: [a] -> [a]
evens l = [l !! i | i <- [0,2..(length l) - 1]]
odds :: [a] -> [a]
odds l = [l !! i | i <- [1,3..(length l) - 1]]
shuffle :: [a] -> [a]
shuffle s | length s == 1 = s
| otherwise = l ++ shuffle r
where l = evens s
r = odds s

A perfect shuffle can be implemented as
perfectShuffle = concat . transpose . chunksOf 2
The speed improvements will come from:
Not calculating the length of the list repeatedly.
Not building up a chain of (++) inefficiently, which will require repeated traversals of the list and give an O(n2) runtime.
Example output:
λ> perfectShuffle [1..10]
[1,3,5,7,9,2,4,6,8,10]
chunksOf is available in the split package. transpose is in Data.List in base.

You should avoid indexing repeatedly into the same list with !! like you do in
evens l = [l !! i | i <- [0,2..(length l) - 1]] -- bad
This takes O(n^2) time where n is the length of l, since l !! i takes O(i) time.
Instead just write something like this:
evens [] = []
evens (x:xs) = x : odds xs
odds xs = evens (drop 1 xs)
Your shuffle itself is fine.

Related

Haskell: Increment elements of a list by cumulative length of previous lists

Here is the list of lists: [[1,2,3],[1,2,3,4],[1,2,3]]
How can I increment each element of the second list by the length of the first list, and increment the third list by the length of the first list + second list? The first list should remain unchanged.
Intended output: [[1,2,3],[4,5,6,7],[8,9,10]]
Since the first list has length 3, the second list is generated by [1+3, 2+3, 3+3, 4+3].
Since the first list + second list combined have length 7, the third list is generated by [1+7, 2+7, 3+7].
Ideally it should work with any number of lists.
So far, I've had slight sucess using this:
scanl1 (\xs ys -> [y + length xs | y <- ys]) [[1,2,3],[1,2,3,4],[1,2,3]]
which outputs: [[1,2,3],[4,5,6,7],[5,6,7]]
scanl1 is a good idea, but it's not quite right, because you don't want your accumulator to be a list, but rather to be an integer. So you really want scanl, not scanl1. I'll leave it as an exercise for you to see how to adjust your solution - given that you managed to write something almost-right with scanl1, I don't think you'll find it too hard once you have the right function.
In the comments, jpmariner suggests mapAccumL :: (s -> a -> (s, b)) -> s -> [a] -> (s, [b])). That's perfectly typed for what we want to do, so let's see how it would look.
import Data.Traversable (mapAccumL)
addPreviousLengths :: [[Int]] -> [[Int]]
addPreviousLengths = snd . mapAccumL go 0
where go n xs = (n + length xs, map (+ n) xs)
λ> addPreviousLengths [[1,2,3],[1,2,3,4],[1,2,3]]
[[1,2,3],[4,5,6,7],[8,9,10]]
mapAccumL really is the best tool for this job - there's not much unnecessary complexity involved in using it. But if you're trying to implement this from scratch, you might try the recursive approach Francis King suggested. I'd suggest a lazy algorithm instead of the tail-recursive algorithm, though:
incrLength :: [[Int]] -> [[Int]]
incrLength = go 0
where go _ [] = []
go amount (x:xs) =
map (+ amount) x : go (amount + length x) xs
It works the same as the mapAccumL version. Note that both versions are lazy: they consume only as much of the input list as necessary. This is an advantage not shared by a tail-recursive approach.
λ> take 3 . incrLength $ repeat [1]
[[1],[2],[3]]
λ> take 3 . addPreviousLengths $ repeat [1]
[[1],[2],[3]]
There are many ways to solve this. A simple recursion is one approach:
lst :: [[Int]]
lst = [[1,2,3],[1,2,3,4],[1,2,3]]
incrLength :: [[Int]] -> Int -> [[Int]] -> [[Int]]
incrLength [] _ result = result
incrLength (x:xs) amount result =
incrLength xs (amount + length x) (result ++ [map (+amount) x])
(Edit: it is more efficient to use (:) in this function. See #amalloy comment below. The result then has to be reversed.
incrLength :: [[Int]] -> Int -> [[Int]] -> [[Int]]
incrLength [] _ result = reverse result
incrLength (x:xs) amount result =
incrLength xs (amount + length x) (map (+amount) x : result)
End Edit)
Another approach is to use scanl. We use length to get the length of the inner lists, then accumulate using scanl.
map length lst -- [3,4,3]
scanl (+) 0 $ map length lst -- [0,3,7,10]
init $ scanl (+) 0 $ map length lst -- [0,3,7]
Then we zip the lst and the accumulated value together, and map one over the other.
incrLength' :: [[Int]] -> [[Int]]
incrLength' lst =
[map (+ snd y) (fst y) | y <- zip lst addlst]
where
addlst =init $scanl (+) 0 $ map length lst
main = do
print $ incrLength lst 0 [] -- [[1,2,3],[4,5,6,7],[8,9,10]]

Haskell permutations with the length of the output list

I have such code for creating permutations:
--unique permutation
perm :: [t] -> [[t]]
perm [] = [[]]
perm (x:xs) = [(y:zs) | (y,ys) <- views (x:xs), zs <- perm ys]
--create all possible views
views :: [t] -> [(t,[t])]
views [] = []
views (x:xs) = ((x,xs) : [ (y,(x:ys)) | (y,ys) <- views xs ])
However I want to limit the output to a certain length. For example, it should take a parameter specifying the number of elements in the ouput of the permutation. I want to create k distinct permutations drawn from a list [0..9].
So, for example, if k will be equal to 3, then the output should be something like this:[1,2,3], [9,8,7], [0,6,8] etc..
Right now if i pass [0..9] to the function it will generate a list with permutations of length 10. I am struggling to come up with a solution.
In the end, the function should look like perm k list
Thank you!
It is connected with this question: Verbal Arithmetics in Haskell (SEND + MORE = MONEY)
Do you mean something like this?
import Data.List (permutations)
choose n list = concatMap permutations $ choose' list [] where
choose' [] r = if length r == n then [r] else []
choose' (x:xs) r | length r == n = [r]
| otherwise = choose' xs (x:r)
++ choose' xs r
Output:
*Main> choose 2 [0..5]
[[1,0],[0,1],[2,0],[0,2],[3,0],[0,3],[4,0],[0,4],[5,0],[0,5],[2,1]
,[1,2],[3,1],[1,3],[4,1],[1,4],[5,1],[1,5],[3,2],[2,3],[4,2],[2,4]
,[5,2],[2,5],[4,3],[3,4],[5,3],[3,5],[5,4],[4,5]]
Will replicateM do what you need?
Prelude Control.Monad> take 10 $ replicateM 3 [0..9]
[[0,0,0],[0,0,1],[0,0,2],[0,0,3],[0,0,4],[0,0,5],[0,0,6],[0,0,7],[0,0,8],[0,0,9]]
Prelude Control.Monad> take 10 $ replicateM 4 [1,3,3,7]
[[1,1,1,1],[1,1,1,3],[1,1,1,3],[1,1,1,7],[1,1,3,1],[1,1,3,3],[1,1,3,3],[1,1,3,7],[1,1,3,1],[1,1,3,3]]
Prelude Control.Monad> take 10 $ replicateM 2 [4,2]
[[4,4],[4,2],[2,4],[2,2]]

split an arbitrary set s into two subsets of fixed size

In order to split an arbitrary set s into two subsets l and r, in which l has a fixed size n, I have written the following code:
parts :: Int -> [a] -> [([a], [a])]
parts n ls = (filter len . f) ls
where len (lhs,rhs) = length lhs==n -- the condition that the left subset is of fixed size n
f [] = [([],[])]
f (x:xs) = [ (x:l,r) | (l,r)<-f xs] ++ [ (l,x:r) | (l,r)<-f xs]
Here is a sample of its effect. Evaluating parts 2 "12345" yields:
[ ("12","345")
, ("13","245")
, ("14","235")
, ("15","234")
, ("23","145")
, ("24","135")
, ("25","134")
, ("34","125")
, ("35","124")
, ("45","123")
]
Please notice that my solution enumerates all subsets and then filters out the desired ones. I suppose the subsets function is familiar to you:
subsets :: [a] -> [[a]]
subsets [] = [[]]
subsets (x:xs) = map (x:) (subsets xs) ++ subsets xs
Personally, I find my solution disappointing. It filters the correct answers from a larger set. My question to the reader is:
Can you come up with a function that is equivalent to parts, but produces the answer directly without this a-posteriory filter?
Inspired by subsets, you might end up with
import Control.Arrow (first, second)
-- first f (x,y) = (f x, y) ; second f (x, y) = (x, f y)
parts n xs = parts' 0 xs where
parts' l (x:xs) | l < n = map (first (x:)) (parts' (l + 1) xs) ++ -- 1a
map (second (x:)) (parts' l xs) -- 1b
parts' l xs | l == n = [([],xs)] -- 2
parts' _ _ = [] -- 3
l contains the length of the first pair so far. As long as the pair isn't yet long enough, we take the first element of the list, and append it to all first elements in our pairs (1a). We're also going to map it onto the second elements (1b). Note that in this case the length of the first pairs didn't increase.
When the first pairs just happen to be long enough (2), we're going to put all other elements into the second half of the pair.
When the requirements for the guards do not hold (list exhausted), we return [] (3). This approach also retains the relative ordering of elements:
> parts 2 "12345"
[
("12","345"),
("13","245"),
("14","235"),
("15","234"),
("23","145"),
("24","135"),
("25","134"),
("34","125"),
("35","124"),
("45","123")
]
This approach will also work on infinite lists:
> map (second (const "...")) $ take 5 $ parts 3 [1..]
[([1,2,3],"..."),([1,2,4],"..."),([1,2,5],"..."),([1,2,6],"..."),([1,2,7],"...")]
(The second elements in the pairs will still be infinite lists)
Ok this is what I came up with:
parts :: Int -> [a] -> [([a],[a])]
parts n list = parts' 0 (length list) [] [] list where
parts' _ _ ls rs [] = [(ls,rs)]
parts' n' l ls rs as#(x:xs) | n' >= n = [(reverse ls, reverse rs ++ as)]
| n' + l <= n = [(reverse ls ++ as, reverse rs)]
| otherwise = parts' (n' + 1) (l - 1) (x : ls) rs xs
++ parts' n' (l - 1) ls (x : rs) xs
If it doesn't matter if the elements of the subsets are in the same order as they were in the original set, then you can remove the four uses of reverse.
Sliding split can be done using zipWith of inits and tails. For each split produce the solution for a smaller sublist, and append the element at the point of split to all such solutions.
parts 0 xs = [([],xs)]
parts n xs = concat $ zipWith f (inits xs) (init $ tails xs) where
f hs (h:ts) = [(h:t', hs++ts') | (t', ts') <- parts (n-1) ts]
-- f hs [] not possible - init $ tails xs does not produce empty lists

Haskell powerset sublists with fixed length

It's well known that the powerset of a list:
{1,2,3,4} is {{},{1},{2},{1,2},{3},{1,3},{2,3},{1,2,3},{4},{1,4},{2,4},{1,2,4},{3,4},{1,3,4},{2,3,4},{1,2,3,4}}
the haskell code I got for that problem is:
potencia [] = [[]]
potencia (a:bs) = potencia bs ++ map (a:) (potencia bs)
Now, how would I get a list of sublists of the same length?, for example, the list above would generate the next list of sublists of length 3 = {{1,2,3},{1,2,4},{1,3,4}}
I'm a student sorry for my english, thanks in advance... XD
How about
sublists _ 0 = [[]]
sublists [] _ = []
sublists (x:xs) n = sublists xs n ++ map (x:) (sublists xs $ n - 1)
Which is very similar to the code you had but just has two decreasing parameters, the length and the list.
Also, for more advanced Haskellers
powerset = flip runCont id . foldM step [[]]
where step xs x = cont $ \c -> c xs ++ c (map (x:) xs)
is a powerset implementation without recursion using continuations. Doing the same with the sublists function is an interesting challenge.
I'm thinking just
subsequencesOf :: Int -> [a] -> [[a]]
subsequencesOf n = filter ((== n) . length) . subsequences
Which will give you
> subsequencesOf 3 [1, 2, 3, 4]
[[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
Although I find it weird that this isn't an operation in Data.Set, and that Set isn't a monad (and therefore has its own version of replicateM.) I guess there might be obstacles in the way there.

How to define a rotates function

How to define a rotates function that generates all rotations of the given list?
For example: rotates [1,2,3,4] =[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
I wrote a shift function that can rearrange the order
shift ::[Int]->[Int]
shift x=tail ++ take 1 x
but I don't how to generate these new arrays and append them together.
Another way to calculate all rotations of a list is to use the predefined functions tails and inits. The function tails yields a list of all final segments of a list while inits yields a list of all initial segments. For example,
tails [1,2,3] = [[1,2,3], [2,3], [3], []]
inits [1,2,3] = [[], [1], [1,2], [1,2,3]]
That is, if we concatenate these lists pointwise as indicated by the indentation we get all rotations. We only get the original list twice, namely, once by appending the empty initial segment at the end of original list and once by appending the empty final segment to the front of the original list. Therefore, we use the function init to drop the last element of the result of applying zipWith to the tails and inits of a list. The function zipWith applies its first argument pointwise to the provided lists.
allRotations :: [a] -> [[a]]
allRotations l = init (zipWith (++) (tails l) (inits l))
This solution has an advantage over the other solutions as it does not use length. The function length is quite strict in the sense that it does not yield a result before it has evaluated the list structure of its argument completely. For example, if we evaluate the application
allRotations [1..]
that is, we calculate all rotations of the infinite list of natural numbers, ghci happily starts printing the infinite list as first result. In contrast, an implementation that is based on length like suggested here does not terminate as it calculates the length of the infinite list.
shift (x:xs) = xs ++ [x]
rotates xs = take (length xs) $ iterate shift xs
iterate f x returns the stream ("infinite list") [x, f x, f (f x), ...]. There are n rotations of an n-element list, so we take the first n of them.
The following
shift :: [a] -> Int -> [a]
shift l n = drop n l ++ take n l
allRotations :: [a] -> [[a]]
allRotations l = [ shift l i | i <- [0 .. (length l) -1]]
yields
> ghci
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> allRotations [1,2,3,4]
[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
which is as you expect.
I think this is fairly readable, although not particularly efficient (no memoisation of previous shifts occurs).
If you care about efficiency, then
shift :: [a] -> [a]
shift [] = []
shift (x:xs) = xs ++ [x]
allRotations :: [a] -> [[a]]
allRotations l = take (length l) (iterate shift l)
will allow you to reuse the results of previous shifts, and avoid recomputing them.
Note that iterate returns an infinite list, and due to lazy evaluation, we only ever evaluate it up to length l into the list.
Note that in the first part, I've extended your shift function to ask how much to shift, and I've then a list comprehension for allRotations.
The answers given so far work fine for finite lists, but will eventually error out when given an infinite list. (They all call length on the list.)
shift :: [a] -> [a]
shift xs = drop 1 xs ++ take 1 xs
rotations :: [a] -> [[a]]
rotations xs = zipWith const (iterate shift xs) xs
My solution uses zipWith const instead. zipWith const foos bars might appear at first glance to be identical to foos (recall that const x y = x). But the list returned from zipWith terminates when either of the input lists terminates.
So when xs is finite, the returned list is the same length as xs, as we want; and when xs is infinite, the returned list will not be truncated, so will be infinite, again as we want.
(In your particular application it may not make sense to try to rotate an infinite list. On the other hand, it might. I submit this answer for completeness only.)
I would prefer the following solutions, using the built-in functions cycle and tails:
rotations xs = take len $ map (take len) $ tails $ cycle xs where
len = length xs
For your example [1,2,3,4] the function cycle produces an infinite list [1,2,3,4,1,2,3,4,1,2...]. The function tails generates all possible tails from a given list, here [[1,2,3,4,1,2...],[2,3,4,1,2,3...],[3,4,1,2,3,4...],...]. Now all we need to do is cutting down the "tails"-lists to length 4, and cutting the overall list to length 4, which is done using take. The alias len was introduced to avoid to recalculate length xs several times.
I think it will be something like this (I don't have ghc right now, so I couldn't try it)
shift (x:xs) = xs ++ [x]
rotateHelper xs 0 = []
rotateHelper xs n = xs : (rotateHelper (shift xs) (n - 1))
rotate xs = rotateHelper xs (length xs)
myRotate lst = lst : myRotateiter lst lst
where myRotateiter (x:xs) orig
|temp == orig = []
|otherwise = temp : myRotateiter temp orig
where temp = xs ++ [x]
I suggest:
rotate l = l : rotate (drop 1 l ++ take 1 l)
distinctRotations l = take (length l) (rotate l)

Resources