Recursive definition of function choose k xs - haskell

I'm trying to solve the following problem found in "Introduction to functional programming" First edition Bird-Wadler.
5 .6.2 The function choose k xs returns a list of all subsequences of xs whose
length is exactly k. For example:
? choose 3 "list"
["ist" , "lst" , "lit" , "lis"]
Give a recursive definition of choose. Show that if xs has length n then
choose k xs has length nk
I only could come up with a non-recursive solution based on a function that returns the list of subsets of an array:
subs :: [a] -> [[a]]
subs [] = [[]]
subs (x:xs) = subs xs ++ map (x:) (subs xs)
choose :: Int -> [a] -> [[a]]
choose x = filter ((== x) . length) . subs

I think you are asking:
What is a lone, recursive function solution to this problem?
These problems usually can be solved if you mentally walk through the base and recursive cases carefully. For example:
Choose is a function from ints and list of values to a list of lists of values:
choose :: Int -> [a] -> [[a]]
If the result is supposed to be 0 length then there is exactly one sublist of said length:
choose 0 _ = [ [] ]
If the result is non-zero but we have no more characters with which to make a sublist then there are no solutions:
choose _ [] = []
Otherwise we can take the first character and append that to all solutions of length one shorter:
choose n (x : xs) =
map (x :) (choose (n - 1) xs)
Or we discard this character (ex, drop 'l' and get the result "ist") and look for a solution with the substring:
++ choose n xs

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: merging list of lists

given a list of list pairs ::[a,a], I would like to return the possible combinations of lists, where the sublists have been merged on the last of one sublit matching head of the next.
for example
-- combine two lists if they front and back match
merge :: Eq a => [[a]] -> [[a]]
merge (x:y:ys) | last x == head y = merge $ (x ++ (drop 1 y)) : ys
| otherwise = []
merge xs = xs
combinations :: Eq a => [[a]] -> [[a]]
combinations = nub . concatMap merge . permutations
λ= merge [1,2] [2,3]
[1,2,3]
-- there should be no duplicate results
λ= combinations [[1,3],[1,3],[1,3],[1,3],[2,1],[2,1],[2,1],[2,2],[3,2],[3,2],[3,2]]
[[1,3,2,2,1,3,2,1,3,2,1,3],[1,3,2,1,3,2,2,1,3,2,1,3],1,3,2,1,3,2,1,3,2,2,1,3]]
-- the result must be a completely merged list or an empty list
λ= combinations [[1,3], [3,1], [2,2]]
[]
λ= combinations [[1,3], [3, 1]]
[[1,3,1],[3,1,3]]
λ= combinations [[1,3],[3,1],[3,1]]
[[3,1,3,1]]
I can't quite wrap my head around the recursion needed to do this efficiently.
I ended with this solution, but it contains duplicates (you can use Data.List(nub) to get rid of them).
import Data.List(partition)
main :: IO ()
main = do
print $ show tmp
input = [[1,3],[1,3],[1,3],[1,3],[2,1],[2,1],[2,1],[2,2],[3,2],[3,2],[3,2]]
tmp = combinations input
-- this function turns list into list of pair, first element is element of the
-- input list, second element is rest of the list
each :: [a] -> [a] -> [(a, [a])]
each h [] = []
each h (x:xs) = (x, h++xs) : each (x:h) xs
combinations :: (Eq a) => [[a]] -> [[a]]
combinations l = concat $ map combine $ each [] l
where
-- take pair ("prefix list", "unused lists")
combine :: (Eq a) => ([a], [[a]]) -> [[a]]
combine (x, []) = [x]
combine (x, xs) = let
l = last x
-- split unused element to good and bad
(g, b) = partition (\e -> l == head e) xs
s = each [] g
-- add on element to prefix and pass rest (bad + good except used element) to recursion. so it eat one element in each recursive call.
combine' (y, ys) = combine (x ++ tail y, ys ++ b)
-- try to append each good element, concat result
in concat $ map combine' s
I'm not sure if I fully understand what you want to do, so here are just a few notes and hints.
given a list of list pairs ::[a,a]
(...) for example
λ= merge [1,2] [2,3]
Firstly those are not lists of pairs, each element of the list is an integer not a pair. They just happen to be lists with two elements. So you can say they are of type [Int] or an instance of type [a].
the sublists have been merged on the last of one sublit matching head of the next.
This suggests that the size of the lists will grow, and that you will constantly need to inspect their first and last elements. Inspecting the last element of a list implies traversing it each time. You want to avoid that.
This suggests a representation of lists with extra information for easy access. You only need the last element, but I'll put first and last for symmetry.
-- lists together with their last element
data CL a = CL [a] a a
cl :: [a] -> CL a
cl [] = error "CL from empty list"
cl xs = CL xs (head xs) (last xs)
clSafe :: [a] -> Maybe (CL a)
clSafe [] = Nothing
clSafe xs = Just (cl xs)
clFirst (CL _ x _) = x
clLast (CL _ _ x) = x
compatible cs ds = clLast cs == clFirst ds
Perhaps better, maybe you should have
data CL a = CL [a] a a | Nil
And to include an empty list that is compatible with all others.
Another point to take into account is that if e.g., you have a list xs and want to find lists ys to combine as ys++xs, then you want it to be very easy to access all ys with a given last element. That suggests you should store them in a suitable structure. Maybe a hash table.

Splitting lists in Haskell

In Haskell I need to perform a function, whose declaration of types is as follows:
split ::[Integer] -> Maybe ([Integer],[Integer])
Let it work as follows:
split [1,2,3,4,5,15] = Just ([1,2,3,4,5],[15])
Because, 1 + 2 + 3 + 4 + 5 = 15
split [1,3,3,4,3] = Just ([1,3,3],[4,3])
Because, 1 + 3 + 3 = 7 = 4 + 3
split [1,5,7,8,0] = Nothing
I have tried this, but it doesn't work:
split :: [Integer] -> ([Integer], [Integer])
split xs = (ys, zs)
where
ys <- subsequences xs, ys isInfixOf xs, sum ys == sum zs
zs == xs \\ ys
Determines whether the list of positive integers xs can be divided into two parts (without rearranging its elements) with the same sum. If possible, its value is the pair formed by the two parts. If it's not, its value is Nothing.
How can I do it?
Not a complete answer, since this is a learning exercise and you want hints, but if you want to use subsequences from Data.List, you could then remove each element of the subsequence you are checking from the original list with \\, to get the difference, and compare the sums. You were on the right track, but you need to either find the first subsequence that works and return Just (ys, zs), or else Nothing.
You can make the test for some given subsequence a predicate and search with find.
What you could also do is create a function that gives all possible splittings of a list:
splits :: [a] -> [([a], [a])]
splits xs = zipWith splitAt [1..(length xs)-1] $ repeat xs
Which works as follows:
*Main> splits [1,2,3,4,5,15]
[([1],[2,3,4,5,15]),([1,2],[3,4,5,15]),([1,2,3],[4,5,15]),([1,2,3,4],[5,15]),([1,2,3,4,5],[15])]
Then you could just use find from Data.List to find the first pair of splitted lists that have equal sums:
import Data.List
splitSum :: [Integer] -> Maybe ([Integer], [Integer])
splitSum xs = find (\(x, y) -> sum x == sum y) $ splits xs
Which works as intended:
*Main> splitSum [1,2,3,4,5,15]
Just ([1,2,3,4,5],[15])
Since find returns Maybe a, the types automatically match up.

Subsets of elements of a list in Haskell

Can anyone help me to generate all the subsets of a given set?
Example:If I have [2,3,4] and if I want K=2, that means I need pairs of two => [[2,3], [3,2], [2,4], [4,2], [3,4], [4,3]]
I wrote this code, but it generates only the number of subsets:
arrange::Int->Int->Int
arrange n 1=n
arrange n r=n*arrange (n-1) (r-1)
Another version, but this doesn't generate all solutions of the subsets:
arrange 0 _ =[[]]
arrange _ []=[]
arrange n (x:xs)=(map(x:)) (arrange (n-1) xs)++
(arrange n xs)
Well based on your example this is a possible solution:
import Data.List (permutations)
pick :: Int -> [a] -> [[a]]
pick 0 _ = [[]]
pick _ [] = []
pick n (x:xs) = map (x:) (pick (n-1) xs) ++ pick n xs
arrange :: Int -> [a] -> [[a]]
arrange n = concatMap permutations . pick n
example
λ> arrange 2 [2,3,4]
[[2,3],[3,2],[2,4],[4,2],[3,4],[4,3]]
as you can see the trick is just picking a number of elements and then getting all permutations of the results (using concatMap to concat them together)
of course this might be homework so you might want to implement permutations by yourself ;)

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