Compute all sublists with nth element removed - haskell

I'm looking for a function f that, given a list of n elements, computes a list of n sublists of length n-1. Furthermore the nth sublist should contain all but the nth element of the original list. E.g:
f [1..4] == [[2,3,4], [1,3,4], [1,2,4], [1,2,3]]
I found a solution that seems to work, but it looks rather unintuitive:
f :: [a] -> [[a]]
f [] = []
f xs = reverse $ go (length xs - 1) xs
where
go 0 _ = [[]]
go n xs = [ y:ys | y:xs' <- tails xs, ys <- go (n-1) xs' ]
Any suggestions for a more comprehensible solution with reasonable performance?

f xs = [ ys ++ zs | (ys, _ : zs) <- zip (inits xs) (tails xs) ]
inits and tails give you all prefixes and suffixes, in order (take a look at the result of zip (inits xs) (tails xs)). The list comprehension takes one element out of each non-empty suffix (_ : zs), and then concatenates the remaining elements together.

You can simplify a lot by observing that the homework problem contains a recursive structure that neatly matches recursion along the list itself. If you pattern match on the input and it's non-empty, it has a first element of the list then the rest of the list. The rest of the list neatly corresponds to the original list without the first element, so it should be the first output. Then comes the recursion - getting the rest of the results is just a straight-forward application of f to the rest of the list and then fixing up the values so they're the right length and start with the right element.

Related

Take symmetrical pairs, of different numbers from list

I have a list like this:
[(2,3),(2,5),(2,7),(3,2),(3,4),(3,6),(4,3),(4,5),(4,7),(5,2),(5,4),(5,6),(6,3),(6,5),(6,7),(7,2),(7,4),(7,6)]
The digits are from [2..7]. I want to take a set where there are any symmetrical pairs. e.g. [(1,2),(2,1)], but those two numbers aren't used again in the set. An example would be:
[(3,6),(6,3),(2,5),(5,2),(4,7),(7,4)]
I wanted to first put symmetric pairs together as I thought it might be easier to work with so i created this function, which actually creates the pairs and puts them in another list
g xs = [ (y,x):(x,y):[] | (x,y) <- xs ]
with which the list turns to this:
[[(3,2),(2,3)],[(5,2),(2,5)],[(7,2),(2,7)],[(2,3),(3,2)],[(4,3),(3,4)],[(6,3),(3,6)],[(3,4),(4,3)],[(5,4),(4,5)],[(7,4),(4,7)],[(2,5),(5,2)],[(4,5),(5,4)],[(6,5),(5,6)],[(3,6),(6,3)],[(5,6),(6,5)],[(7,6),(6,7)],[(2,7),(7,2)],[(4,7),(7,4)],[(6,7),(7,6)]]
Then from here I was hoping to somehow remove duplicates.
I made a function that will look at all of the fst elements of all of the pairs:
flatList xss = [ x | xs <- xss, (x,y) <- xs ]
to use with another function to remove the duplicates.
h (x:xs) | (fst (head x)) `elem` (flatList xs) = h xs
| otherwise = (head x):(last x):(h xs)
which gives me the list
[(3,6),(6,3),(5,6),(6,5),(2,7),(7,2),(4,7),(7,4),(6,7),(7,6)]
which has duplicate numbers. That function only takes into account the first element of the first pair in the list of lists,the problem is when I also take into account the first element of the second pair (or the second element of the first pair):
h (x:xs) | (fst (head x)) `elem` (flatList xs) || (fst (last x)) `elem` (flatList xs) = h xs
| otherwise = (head x):(last x):(h xs)
I only get these two pairs:
[(6,7),(7,6)]
I see that the problem is that this method of deleting duplicates grabs the last repeated element, and would work with a list of digits, but not a list of pairs, as it misses pairs it needs to take.
Is there another way to solve this, or an alteration I could make?
It probably makes more sense to use a 2-tuple of 2-tuples in your list comprehension, since that makes it more easy to do pattern matching, and thus "by contract" enforces the fact that there are two items. We thus can construct 2-tuples that contain the 2-tuples with:
g :: Eq a => [(a, a)] -> [((a, a), (a, a))]
g xs = [ (t, s) | (t#(x,y):ts) <- tails xs, let s = (y, x), elem s ts ]
Here the elem s ts checks if the "swapped" 2-tuple occurs in the rest of the list.
Then we still need to filter the elements. We can make use of a function that uses an accumulator for the thus far obtained items:
h :: Eq a => [((a, a), (a, a))] -> [(a, a)]
h = go []
where go _ [] = []
go seen ((t#(x, y), s):xs)
| notElem x seen && notElem y seen = t : s : go (x:y:seen) xs
| otherwise = go seen xs
For the given sample input, we thus get:
Prelude Data.List> (h . g) [(2,3),(2,5),(2,7),(3,2),(3,4),(3,6),(4,3),(4,5),(4,7),(5,2),(5,4),(5,6),(6,3),(6,5),(6,7),(7,2),(7,4),(7,6)]
[(2,3),(3,2),(4,5),(5,4),(6,7),(7,6)]
after reading a few times your question, I got an elegant solution to your problem. Thinking that if you have a list of pairs without any repeated number, you can get the list of swapped pairs easily, solving your problem. So your problem can be reduce to given a list, get the list of all pairs using each number just one.
For a given list, there are many solutions to this, ex: for [1,2,3,4] valid solutions are: [(2,4),(4,2),(1,3),(3,1)] and [(2,3),(3,2),(1,4),(4,1)], etc... The approach here is:
take a permutation if the original list (say [1,4,3,2])
pick one element for each half and pair them together (for simplicity, you can pick consecutive elements too)
for each pair, create a the swapped pair and put all together
By doing so you end up with a list of non repeating numbers of pairs and its symmetric. More over, looping around all permutaitons, you can get all the solutions to your problem.
import Data.List (permutations, splitAt)
import Data.Tuple (swap)
-- This function splits a list by the half of the length
splitHalf :: [a] -> ([a], [a])
splitHalf xs = splitAt (length xs `quot` 2) xs
-- This zip a pair of list into a list of pairs
zipHalfs :: ([a], [a]) -> [(a,a)]
zipHalfs (xs, ys) = zip xs ys
-- Given a list of tuples, creates a larger list with all tuples and all swapped tuples
makeSymetrics :: [(a,a)] -> [(a,a)]
makeSymetrics xs = foldr (\t l -> t:(swap t):l) [] xs
-- This chain all of the above.
-- Take all permutations of xs >>> for each permutations >>> split it in two >>> zip the result >>> make swapped pairs
getPairs :: [a] -> [[(a,a)]]
getPairs xs = map (makeSymetrics . zipHalfs . splitHalf) $ permutations xs
>>> getPairs [1,2,3,4]
[[(1,3),(3,1),(2,4),(4,2)],[(2,3),(3,2),(1,4),(4,1)] ....

separate even and odd elements of list haskell

I am trying to separate elements of a list into to further lists, one for the odd and one for even numbers.
For Example,
input: [1,2,3,4,10]
output: ([2,4,10],[1,3])
sepList :: [Int]->([Int],[Int])
sepList [] = ([],[])
sepList (x:xs) | (x mod 2) ==0 = (([x],[]) ++ sepList xs)
| (x mod 2) /=0 = (([],[x]) ++ sepList xs)
| otherwise = ([],[])
It gives error on ...++ sepList xs
anyone could guide me here?
The operator++ is used to concatenate 2 lists and neither of your arguments to ++ is a list,
([x],[]) ++ sepList xs
both ([x],[]) and sepList xs are pairs of lists. So what you want is to pattern match on sepList xs e.g. using a let binding,
let (ys,zs) = sepList xs in
and then return,
(x:ys,zs)
You aren't concatenating two lists; you want to add a single element to a list, selected from the tuple output of the recursive call. Don't use (++); use (:).
sepList (x:xs) = let (evens, odds) = sepList xs
in if even x
then (x:evens, odds)
else (evens, x:odds)
More simply, though, sepList = partition even. (partition can be found in Data.List.)
There are two answers so far which suggest basically doing this by hand (by pattern-matching on the result of the recursive call), but there is actually an operator already defined for the types that you're working with that does exactly what you want! Lists form a monoid with (<>) = (++), but you don't have two lists: you have two pairs of lists. Happily, the type of pairs are also a monoid if each element of the pair is a monoid: (a,b) <> (c,d) = (a <> c, b <> d). So, you can simply replace your ++ call with <>, which will result in concatenating the corresponding lists in your pairs.
For enthusiasts, following one line will also work for separating list in even and odd.
sepList xs = (filter even xs , filter odd xs)
import Data.List
sepList :: [Int]->([Int],[Int])
sepList = partition even
sepList [1,2,3,4,10]
In this case i would use an accumulator to create the tuple containing the two lists.In our case the accumulator is ([],[]).
split::[Int]->([Int],[Int])
split ls= go ([],[]) ls where
go accu [] = accu
go (odd,even) (x:xs) | x `mod` 2==0 = go (x:odd,even) xs
| otherwise = go (odd, x:even) xs
As you can see the elements need to be reversed since we are pushing on top of our lists with the : operator.
I do not know if this is optimal but i would write it like this with reverse:
module Split where
split::[Int]->([Int],[Int])
split ls=let rev tupl=(reverse . fst $ tupl ,reverse .snd $ tupl) in
rev $ go ([],[]) ls where
go accu [] = accu
go (odd,even) (x:xs) | x `mod` 2==0 = go (x:odd,even) xs
| otherwise = go (odd, x:even) xs

Printing sublists of list with odd length haskell programming

I want to print sublists of list having odd length. i coded this.
sublists :: [a] -> [[a]]
sublists [] = [[]]
sublists (x:xs) = if odd (length (tail xs))
then [x:sublist | sublist <- sublists xs] ++ sublists xs
else sublists xs
eg: sublists [1,2,3,4,5,6]
I am getting output as :
[[1,3,5],[1,3],[1,5],[1],[3,5],[3],[5],[]]
I want :
[[1,3,5],[2,3,4],[2,3,5],[1],[2,3,6],[3],[5],[2],[4],[6],[1,2,3],[1,2,4],[1,2,5],[1,2,6],[1,3,4],[1,3,6],[1,4,5],[1,4,6],[1,5,6],[2,4,5],[2,4,6],[2,5,6],[3,4,5],[3,4,6],[3,5,6],[4,5,6],[]]
I think I'd reuse subsequences until I was pretty sure this was the bottleneck. Especially since you seem comfortable calling length a lot, it seems like efficiency isn't a big concern. So:
Data.List> filter (odd . length) . subsequences $ [1..4]
[[1],[2],[3],[1,2,3],[4],[1,2,4],[1,3,4],[2,3,4]]

26 of 99 Haskell problems - why the result contains multiple lists with the same head?

I am trying to figure out how one of the solutions to problem 26 of 99 Haskell problems works. The solution is as follows:
combination :: Int -> [a] -> [[a]]
combination 0 _ = [ [] ]
combination i xs = [ y:ys | y:xs' <- tails xs, ys <- combination (i-1) xs']
I can't understand how it is possible that there will be more than one list with the same head. To me the y part in y:ys that will be produced from using tails xs can be used only to compose one list.
Example:
combination 2 [1,2,3]
First we take the y part from tails xs, which gives us three lists: [1,(not known yet)], [2,(not known yet)], [3,(not known yet)]. So how come at the end we get multiple results with 1 as the head?
I also can't grasp why the list [3] won't be in the result? It certainly will appear as a head in one of the lists produced by tails xs. I didn't want to raise this concern in a separate question - I hope that's fine.
List comprehensions define nested loops, in a way. Thus, in the definition
combinations n xs =
we can read the code
[ y:ys | y:t <- tails xs, ys <- combinations (n-1) t]
as
for each (y:t) in (tails xs)
for each ys in (combinations (n-1) t)
produce (y:ys) as a new element of the resulting list
In other words, to pick n elements from a list means to pick some element, and n-1 elements after it in the list.
The non-deterministic nature of this definition is represented by producing a list of all the possible solutions, as the result. We pick the n-1 elements only to the right of the element, to only produce solutions that are unique under permutation.
Let's take xs = [1,2,3] as an example. What does tails [1,2,3] produce?
It's [[1,2,3], [2,3], [3], []], of course. Now, that's equivalent to
[ r | r <- [[1,2,3], [2,3], [3], []] ]
That means, r drawn from that list, takes on the values of its elements, consecutively. r is an irrefutable pattern there; (y:t) is a refutable pattern, i.e. it will fail to match the [] element:
[ (y,t) | (y:t) <- tails [1,2,3]]
=> [(1,[2,3]), (2,[3]), (3,[])]
So you see, t is not "not known yet". It is known, it's just the tail of a given list. And when y matches with 3, t is matched with [].
Moreover,
[ (y,q) | (y:t) <- tails [1,2,3], q <- [10,20]]
=> [(1,10), (1,20), (2,10), (2,20), (3,10), (3,20)]
This is illustrative enough, hopefully, to clear your first question: for each matching (y:t) pattern, q is drawn from [10,20], i.e. it also takes on the values in the list (here, [10,20]) consecutively, for each y, as if in a nested loop.
For your example of combinations 2 [1,2,3] we have
combinations 2 [1,2,3]
=
for each (y,t) in [ (1,[2,3]), (2,[3]), (3,[]) ]
for each ys in (combinations 1 t)
produce (y:ys)
=
for y = 1, t = [2,3]
for each ys in (combinations 1 [2,3]) produce (1:ys) , and then
for y = 2, t = [3]
for each ys in (combinations 1 [3]) produce (2:ys) , and then
for y = 3, t = []
for each ys in (combinations 1 []) produce (3:ys)
combinations 1 [] is [], because tails [] is [[]] and pattern matching (y:t) with [] as part of generator (y:t) <- [[]] will fail; so no solutions will be produced by the third for line (that would have 3 in the solution's head - because there are no more elements to its right to pick the second element from, as we need to pick 2 elements overall; 3 does indeed participate in tails of other solutions, as it well should).
The second for line obviously produces just one solution, [2,3]. What does the first for line produce?
for each ys in (combinations 1 [2,3]) produce (1:ys)
combinations 1 takes just one element, so it produces [2] and [3]; so the first for line produces two solutions, [1,2] and [1,3]. Or in more detail,
combinations 1 [2,3]
=
for y = 2, t = [3]
for each ys in (combinations 0 [3]) produce (2:ys) , and then
for y = 3, t = []
for each ys in (combinations 0 []) produce (3:ys)
and combinations 0 always produces a single solution that is an empty list (a singleton list with an empty list as its only element, [ [] ], representing a solution of picking 0 elements from a list).
So overall, the list of three solutions is returned, [[1,2], [1,3], [2,3]].
The core thing to notice here is the recursive nature of the problem.
How can we pick i items from a list?
If the list is empty, then there are no combinations. So that's not an interesting case.
If the list isn't empty - we can either pick the first item for our combination or not
If we pick it, we still have to pick i-1 items from the rest of the list
If we do not pick it, we still have to pick i items from the rest of the list
Doing:
[ y:ys | y:xs' <- tails xs, ys <- combination (i-1) xs']
Look at all the tails of xs, that is, look at all the possibilities for picking the first element for our i combination.
Pick that first element, as explained above we now have i-1 items, thus, we need to concat that element to the combinations of i-1 items with the remaining items.

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