I want to make all possible combinations of subgroups with 2 lists. Here is a function that does just this:
getCombinations :: [a] -> [[a]]
getCombinations na = do
a <- na
b <- na
[[a,b]]
If you pass "abc" to this function, it returns this:
["aa","ab","ac","ba","bb","bc","ca","cb","cc"]
A simple modification of the same method could return combinations of 3 lists instead of two.
getCombinations :: [a] -> [[a]]
getCombinations na = do
a <- na
b <- na
c <- na
[[a,b,c]]
Result of passing "abc" as an argument:
["aaa","aab","aac","aba","abb","abc","aca","acb","acc",
"baa","bab","bac","bba","bbb","bbc","bca","bcb","bcc",
"caa","cab","cac","cba","cbb","cbc","cca","ccb","ccc"]
What's the simplest way to make it scale to an arbitrary number of lists? Here is what the type declaration should look like:
getCombinations :: Int -> [a] -> [[a]]
What you want is replicateM:
replicateM :: Int -> m a -> m [a]
The definition is as simple as:
replicateM n = sequence . replicate n
so it's sequence on the list monad that's doing the real work here.
For those come here for the combination function, a k-combination of a set S is a subset of k distinct elements of S, note that the order doesn't matter.
Choose k elements from n elements equals choose k - 1 elements from n - 1 elements plus choose k elements from n - 1 elements.
Use this recursive definition, we can write:
combinations :: Int -> [a] -> [[a]]
combinations k xs = combinations' (length xs) k xs
where combinations' n k' l#(y:ys)
| k' == 0 = [[]]
| k' >= n = [l]
| null l = []
| otherwise = map (y :) (combinations' (n - 1) (k' - 1) ys) ++ combinations' (n - 1) k' ys
ghci> combinations 5 "abcdef"
["abcde","abcdf","abcef","abdef","acdef","bcdef"]
The op's question is a repeated permutations, which someone has already given an answer. For non-repeated permutation, use permutations from Data.List.
Related
Can someone else this codes in Haskell:
Doubling Digits
The digits need to be doubled, for this the following function can be defined:
doubleDigits :: [Integer] -> [Integer]
The function doubleDigits must double every other number starting from the right.
The second-to-last number is doubled first, then the fourth-to-last, ..., and so on.
Input: doubleDigits [1,2,3,4,5,6,7]
Output: [1,4,3,8,5,12,7]
toDigitsReverse :: Integer -> [Integer]
toDigitsReverse n = reverse (toDigits n)
-- function to help double every other element of list
doubleDigitsHelper :: [Integer] -> Integer -> [Integer]
doubleDigitsHelper l t
| l == [] = []
| t == 0 = [head l] ++ (doubleDigitsHelper (drop 1 l) 1)
| t == 1 = [2*(head l)] ++ (doubleDigitsHelper (drop 1 l) 0)
-- function to double every other element
doubleDigits :: [Integer] -> [Integer]
doubleDigits l = reverse (doubleDigitsHelper (reverse l) 0)
An alternate approach:
Let's zip the elements of the list with their indices.
[1,2,3,4,5,6,7] `zip` [0..]
We get:
[(1,0),(2,1),(3,2),(4,3),(5,4),(6,5),(7,6)]
Then we can map this to the desired result:
let f (x, i) = if even i then x else x * 2 in map f $ [1,2,3,4,5,6,7] `zip` [0..]
And the result is:
[1,4,3,8,5,12,7]
Or written a little bit differently:
doubleDigits lst = map f lst'
where
lst' = lst `zip` [0..]
f (x, i)
| even i = x
| otherwise = x * 2
Because you want to double every other element starting from the right, you can simply reverse the list, zip it with indices, map, then reserve the output.
doubleDigits lst = reverse $ map f lst'
where
lst' = (reverse lst) `zip` [0..]
f (x, i)
| even i = x
| otherwise = x * 2
I would say that first of all there is no point to reverse list, determine if accumulator (t) is even or odd (there are build in functions for that - for example even) and then act accordingly. Next what can imporve the code - use pattern matching instead of == and head/tail calls. Also I've changed the order of the helper function:
-- function to help double every other element of list
doubleDigitsHelper :: Integer -> [Integer] -> [Integer]
doubleDigitsHelper _ [] = []
doubleDigitsHelper t (x:xs) | even t = x : doubleDigitsHelper (t+1) xs
| otherwise = 2*x : doubleDigitsHelper (t+1) xs
-- function to double every other element
doubleDigits :: [Integer] -> [Integer]
doubleDigits = doubleDigitsHelper 0
You could put the alternating functions you want to apply in a list (cycle [id, (*2)]) and apply these to your list using zipWith.
doubleDigits :: Num a => [a] -> [a]
doubleDigits = reverse . zipWith ($) (cycle [id, (*2)]) . reverse
I don't see an elegant way around reversing the list if you want to alternate starting from the right. You could, for example, look at the length of the list first and change the order of the functions based on that, but that would complicate the function a little.
doubleDigits xs = zipWith ($) fs xs
where fs = (if even . length $ xs then tail else id) $ cycle [id, (*2)]
I am given the assignment of coding a hailstone sequence in Haskell. I must be given an integer and create a list of integers ending with the last number 1, eg.
-- > hailstone 4
-- [4,2,1]
-- > hailstone 6
-- [6,3,10,5,16,8,4,2,1]
-- > hailstone 7
-- [7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
My answer should have just one 1 at the end, however I do not know how to break out of the loop once reaching 1.
hailstone :: Integer -> [Integer]
hailstone = takeWhile (>=1) . (iterate collatz)
where collatz n = if n == 1
then 1
else if even n
then n `div` 2
else 3*n+1
I end up with infinite 1's at the end of this. How can I fix this?
You can use a function like takeUntil :: (a -> Bool) -> [a] -> [a] from the utility-ht package [hackage]. This function will:
Take all elements until one matches. The matching element is returned, too. This is the key difference to takeWhile (not . p). It holds takeUntil p xs == fst (breakAfter p xs).
So we can use that to include the 1:
import Data.List.HT(takeUntil)
hailstone :: Integer -> [Integer]
hailstone = takeUntil (== 1) . iterate collatz
where collatz 1 = 1
collatz n | even n = div n 2
| otherwise = 3 * n + 1
or we can implment takeUntil ourself:
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = go
where go [] = []
go (x:xs) | p x = [x]
| otherwise = x : go xs
or with a fold:
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = foldr (\x y -> x : if p x then [] else y) []
For negative numbers, the collatz can get stuck in an infinite loop:
Prelude> hailstone (-7)
[-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,
We thus might want to change the condition for all numbers less than or equal to 1:
hailstone :: Integer -> [Integer]
hailstone = takeUntil (<= 1) . iterate collatz
where collatz 1 = 1
collatz n | even n = div n 2
| otherwise = 3 * n + 1
All this use of takeUntil, iterate, breaking out has a very imperative feel for me (do something with the numbers until you reach 1 - and then how the hell do I stop? what is the Haskell equivalent of a break statement.....?)
There is nothing wrong with that, and it wil work eventually, but when using Haskell, is often better to think a bit more declaratively: the tail of a hailstone sequence (other than [1]) is another (shorter) hailstone sequence, so hailstone n = n : hailstone (f n) for some f
Thus:
hailstone n
| n == 1 = [1]
| even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (3*n + 1)
The sole classic library function that seems to offer some hope is unfoldr. It uses the Maybe monad, and returning Nothing is what stops the recursion.
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
You have to pick the proper function argument:
import Data.List
hailstone :: Integer -> [Integer]
hailstone n =
let next nn = if (even nn) then (div nn 2) else (3*nn+1)
unfn nn = if (nn==1) then Nothing else let nx = next nn in Just (nx,nx)
in
n : (unfoldr unfn n)
main = do
putStrLn $ "hailstone 7 is: " ++ show (hailstone 7)
That way, the stopping criterion is clearly separated from the successor function.
How would you implement take with a list comprehension?
My approach so far:
take2 :: (Num i, Ord i) => i -> [a] -> [a]
take2 n xs = [x | x <- xs, [x..n]]
The fundamental reason why list comprehensions are not a good fit for the take function is this:
The take function stops the evaluation of the argument list after n elements.
But lists comprehensions always evaluate all elements of the list in the generator. There is no break-statement in Haskell.
You can use some trick to truncate the list before or after using it in the list comprehension, but there is no real point of doing so. That would be similar to first using normal take to truncate the list, then using a list comprehension just to return the result.
We can use a zip approach here, and enumerate over both the elements, and indices, like:
take2 :: (Num i, Enum i) => i -> [a] -> [a]
take2 n xs = [x | (x, _) <- zip xs [1..n]]
Or with the ParallelListComp extension:
{-# LANGUAGE ParallelListComp #-}
take2 :: (Num i, Enum i) => i -> [a] -> [a]
take2 n xs = [x | x <- xs | _ <- [1..n]]
But actually take is probably not a function that is a good fit for list comprehension in the first place.
Without List Comprehension
take' :: Int -> [Int] -> [Int]
take' _ [] = []
take' _ [x] = [x]
take' n all#(x : xs)
| (n > length all) = error "Index too large"
| (n == length all) = all
| (n == 0) = []
| (n < length all) = x : [] ++ (take' (n-1) xs)
take' :: Int -> [a] -> [a]
take' n xs = [xs !! i | i <- [0..n-1]]
I have a list a defined,
let a = ["#","#","#","#"]
How can I rotate the # two spaces, so that it ends up like this?
["#","#","#","#"]
I thought this might work,
map last init a
but maybe the syntax has to be different, because map can only work with one function?
For completeness's sake, a version that works with both empty and infinite lists.
rotate :: Int -> [a] -> [a]
rotate _ [] = []
rotate n xs = zipWith const (drop n (cycle xs)) xs
Then
Prelude> rotate 2 [1..5]
[3,4,5,1,2]
A simple solution using the cycle function, which creates an infinite repetition of the input list:
rotate :: Int -> [a] -> [a]
rotate n xs = take (length xs) (drop n (cycle xs))
then
> rotate 2 ["#","#","#","#"]
["#","#","#","#"].
Why make it complicated?
rotate n xs = bs ++ as where (as, bs) = splitAt n xs
rotate :: Int -> [a] -> [a]
rotate = drop <> take
Because of the instance Monoid b => Monoid (a -> b) instance the above is equivalent to
rotate n = drop n <> take n
and that is in turn equivalent to
rotate n xs = drop n xs <> take n xs
because of the instance Monoid d => Monoid (c -> d) instance, which is equivalent to
rotate n xs = drop n xs ++ take n xs
because of the instance Monoid [e] instance (with b ~ c -> d and d ~ [e]).
(well, Semigroup is enough, but that's the same, here).
I'm very new to haskell, so the MGwynne's answer was easy to understand. Combined with the comment suggesting an alternative syntax, I tried to make it work in both directions.
rotate :: Int -> [a] -> [a]
rotate n xs = take lxs . drop (n `mod` lxs) . cycle $ xs where lxs = length xs
So rotate (-1) [1,2,3,4] gives you the same result as rotate 3 [1,2,3,4].
I thought that I had to add this because dropping less than 0 elements does nothing, so my preferred answer gives "wrong" (at least confusing) results with negative values for the n parameter.
The interesting part of this solution is that it combines "completeness" for negative rotations with the handling of empty lists. Thanks to Haskell's laziness, it also gives correct results for rotate 0 [].
Beginner attempt:
myRotate :: Int -> [String] -> [String]
myRotate 0 xs = xs
myRotate n xs = myRotate (n-1) (last xs : init xs)
Not very fast for large lists, but adequate:
rotate :: Int -> [a] -> [a]
rotate n xs = iterate rot xs !! n
where
rot xs = last xs : init xs
For example:
> rotate 2 ["#","#","#","#"]
["#","#","#","#"]
rotate :: Int -> [a] -> [a]
rotate n xs = drop k xs ++ take k xs
where k = length xs - n
This function rotates by n places to the right.
I want to write a function which takes a list of elements l, a list of indices i, and a list of replacement values v. The function will replace the values in l corresponding to the indices in i with the corresponding value in v.
Example:
If l = [1,2,3,4,5,6], i = [0,2], and v = [166,667], then
replaceValues l i v == [166,2,667,4,5,6]
My function:
--Replace the values in list l at indices in i with the
-- corresponding value in v
replaceValues :: [a] -> [Int] -> [a] -> [a]
replaceValues l [] [] = l
replaceValues l i v = x ++ [head v] ++ (replaceValues (tail y) shiftedIndices (tail v))
where
(x,y) = splitAt (head i) l
--The indices must be shifted because we are changing the list
shiftedIndices = map ((-)((head i) + 1)) (tail i)
This function manages to correctly replace the value at the first index in i, but it misplaces all of the following values. In the example above, it would give the output [166,667,3,4,5,6].
The problem with your implementation is that you aren't keeping track of which index you're currently at.
First of all, you're better off considering using [(Int,a)] rather than [Int] and [a] arguments separate to ensure that the "lists" are equal in length.
An alternate implementation is as follows:
import Data.Maybe(fromMaybe)
import qualified Data.IntMap as M
replaceValues :: [a] -> [(Int,a)] -> [a]
replaceValues as rs = map rep $ zip [0..] as
where
rsM = M.fromList rs
rep (i,a) = fromMaybe a $ M.lookup i rsM
What's happening here:
Tag each value with its index
See if there's a replacement value for that index: if there is, use it; otherwise, use the original value.
The first thing that springs to mind is that you should use a list of tuples to specify the replacement, that is, work with
l = [1,2,3,4,5,6]
r = [(0,166),(2,667)]
... you can use zip to convert your two lists into that format. Then I'm going to stipulate that that list is sorted by the first element of the tuple (sortBy), and that there are no duplicate indices in it (nubBy). The rest is a simple recursion, replacing as you go, with linear complexity and being maximally lazy:
replaceValues :: [a] -> [(Int, a)] -> [a]
replaceValues xs rs = f 0 xs rs
where
f _ xs [] = xs
f _ [] _ = []
f n (x:xs) is#((i,r):is')
| n < i = x:f (n+1) xs is
| n == i = r:f (n+1) xs is'
| otherwise = error "Can't happen"
Beware of the code, though, I have only proven it to be correct, not actually tried it.
Using a map works too, of course, but then you're dealing with an complexity of O(m log m + n log m) (construct map + n times lookup) instead of O(n), or, taking sorting into account, O(n + m log m), as well as lose the capability of being lazy in case your list is already sorted and have the replacements incrementally garbage collected while you traverse.
nubBy from the library has quadratic complexity, but as the list is sorted it can be dealt with in linear time, too, just replace the call to error with a recursive call throwing away superfluous (i,r)s.
as said before, use tuples - but don't forget about pattern matching. Or use Map if you are not dealing with large collections
replaceValues :: [a] -> [Int] -> [a] ->[a]
replaceValues a b i = map fst $ f (zip a [0..]) (zip b i)
where
f [] _ = []
f xs [] = xs
f ((x,i):xs) s2#((j,y):ys) | i == j = (y,i) : f xs ys
| otherwise = (x,i) : f xs s2