Create an infinite list pairs :: [(Integer, Integer)] containing pairs of the form (m,n),
where each of m and n is a member of [0 ..]. An additional requirement is that if (m,n)
is a legit member of the list, then (elem (m,n) pairs) should return True in finite time.
An implementation of pairs that violates this requirement is considered a non- solution.
****Fresh edit Thank you for the comments, Lets see if I can make some progress****
pairs :: [(Integer, Integer)]
pairs = [(m,n) | t <- [0..], m <- [0..], n <-[0..], m+n == t]
Something like this? I just don't know where it's going to return True in finite time.
I feel the way the question is worded elem doesn't have to be part of my answer. Just if you call (elem (m,n) pairs) it should return true. Sound right?
Ignoring the helper method, the list comprehension you have will list out all pairs but the order of elements is a problem. You'll have a infinitely many pairs like (0, m) which are followed by infinitely many pairs like (1, m). Of course elem will forever iterate all the (0, m) pairs never reaching (1, m) or (2, m) etc.
I'm not sure why you have the helper method -- with it, you are only building a list of pairs like [(0,0), (1,1), (2,2), ...] because you've filtered on m = n. Was that part of the requirements?
Like #hammar suggested, start with 0 = m + n and list out the pairs (m, n). Then list pairs (m, n) where 1 = m + n. Then your list will look like [(0,0), (0,1), (1,0), (0,2), (1,1), (2,0), ...].
The helper function ensures that pairs is a list of the form [ (0,0) , (1,1) , (2,2) ... ].
So elem ( m , n ) pairs can be implemented as:
elem (m , n) _ | m == n = True
| otherwise = False
This is a constant time implementation.
I first posted
Prelude> let pairs = [(m, n) | t <- [0..]
, let m = head $ take 1 $ drop t [0..]
, let n = head $ take 1 $ drop (t + 1) [0..]]
Which, I believed answered the three conditions set by the professor. But hammar pointed out that if I chose this list as an answer, that is, the list of pairs of the form (t, t+1), then I might as well choose the list
repeat [(0,0)]
Well, both of these do seem to answer the professor's question, considering there seems to be no mention of the list having to contain all combinations of [0..] and [0..].
That aside, hammer helped me see how you can list all combinations, facilitating the evaluation of elem in finite time by building the infinite list from finite lists. Here are two other finite lists - less succinct than Hammar's suggestion of the diagonals - that seem to build all combinations of [0..] and [0..]:
edges = concat [concat [[(m,n),(n,m)] | let m = t, n <- take m [0..]] ++ [(t,t)]
| t <- [0..]]
*Main> take 9 edges
[(0,0),(1,0),(0,1),(1,1),(2,0),(0,2),(2,1),(1,2),(2,2)]
which construct the edges (t, 0..t) (0..t, t), and
oddSpirals size = concat [spiral m size' | m <- n] where
size' = if size < 3 then 3 else if even size then size - 1 else size
n = map (\y -> (fst y * size' + div size' 2, snd y * size' + div size' 2))
[(x, t-x) | let size' = 5, t <- [0..], x <- [0..t]]
spiral seed size = spiral' (size - 1) "-" 1 [seed]
spiral' limit op count result
| count == limit =
let op' = if op == "-" then (-) else (+)
m = foldl (\a b -> a ++ [(op' (fst $ last a) b, snd $ last a)]) result (replicate count 1)
nextOp = if op == "-" then "+" else "-"
nextOp' = if op == "-" then (+) else (-)
n = foldl (\a b -> a ++ [(fst $ last a, nextOp' (snd $ last a) b)]) m (replicate count 1)
n' = foldl (\a b -> a ++ [(nextOp' (fst $ last a) b, snd $ last a)]) n (replicate count 1)
in n'
| otherwise =
let op' = if op == "-" then (-) else (+)
m = foldl (\a b -> a ++ [(op' (fst $ last a) b, snd $ last a)]) result (replicate count 1)
nextOp = if op == "-" then "+" else "-"
nextOp' = if op == "-" then (+) else (-)
n = foldl (\a b -> a ++ [(fst $ last a, nextOp' (snd $ last a) b)]) m (replicate count 1)
in spiral' limit nextOp (count + 1) n
*Main> take 9 $ oddSpirals 3
[(1,1),(0,1),(0,2),(1,2),(2,2),(2,1),(2,0),(1,0),(0,0)]
which build clockwise spirals of length 'size' squared, superimposed on hammar's diagonals algorithm.
I believe the solution to your task is:
pairs = [(x,y) | u <- [0..], x <- [0..u], y <-[0..u] , u == x+y]
Related
This is a followup to a recent question that wasn't asked clearly. The poster Aditi Jain's clarifications invalidate the answer somewhat that's already posted there, hence this new post.
The objective is to check whether there's no diagonally adjacent pair of elements in the nested lists which are negative of one another. The poster is new to Haskell programming.
The function signature is:
checkNegation :: [[Int]] -> Bool
Examples:
checkNegation [[1,2], [-2,3]] will return False:
[ [ 1 , 2], -- 2, -2 are diagonally adjacent
[-2 , 3] ]
checkNegation [[1,2], [3,-1]] will return False:
[ [ 1 , 2], -- 1, -1 are diagonally adjacent
[ 3 , -1] ]
checkNegation [[1,2], [-1,3]] will return True:
[ [ 1 , 2], -- no diagonally adjacent negatives
[-1 , 3] ]
checkNegation [[0,2,1], [3,1,-2], [3,-1,3]] will return False:
[ [ 0 , 2, 1], -- 2, -2 are diagonally adjacent
[ 3 , 1, -2],
[ 3 , -1, 3] ]
No coding attempts were provided in the original post.
(I'm not marking this as CW so as not to prevent the answerers getting reputation points for their efforts)
It's a little easier to do things if we take the matrix row-by-row. For the following, for instance:
[a,b,c],
[d,e,f],
We only want to compare the pairs:
[(a,e),(b,f),(b,d),(c,e)]
So the first step is to write a function which constructs that list from two adjacent rows.
diags xs ys = zip xs (drop 1 ys) ++ zip (drop 1 xs) ys
We're using drop 1 rather than tail because it doesn't error on the empty list, and the way I'm going to use this function later will use empty lists.
If we use this in a fold, then, it looks like the following:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = fst . foldr f (False, [])
where
f xs (a, ys) = (a || or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys), xs)
We've also made it generic over any relation.
Next we will want to figure out how to check if two numbers are negations of each other.
negEachOther x y = negate x == y
And then our check negation function is as follows:
checkNegation = anyDiags negEachOther
There are some fun things we can do with the anyDiags function here. There's actually a use of the writer monad hidden in it. With that, we can rewrite the fold to use that fact:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = getAny . fst . foldrM f []
where
f xs ys = (Any (or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)), xs)
Though I'm not sure if it's any clearer.
Alternatively, we could do the whole thing using the zip xs (tail xs) trick:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p xs = or (zipWith f xs (tail xs))
where
f xs ys = or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)
We can use the diagonals utility from Data.Universe.Helpers package. Such that
λ> diagonals [[0,2,1], [3,1,-2], [3,-1,3]]
[[0],[3,2],[3,1,1],[-1,-2],[3]]
which is only half of what we need. So lets flip our 2D list and apply diagonals once more. Flipping a list would take reverse . transpose operation such that
λ> (reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1,-2,3],[2,1,-1],[0,3,3]]
now we can use diagonals on this flipped list to obtain the remaining diagonals.
λ> (diagonals . reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1],[2,-2],[0,1,3],[3,-1],[3]]
For all diagonals we need to concatenate them. So altogether we may do like;
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
The rest is applying necessary boolean test.
import Data.List (transpose)
import Data.Universe.Helpers (diagonals)
checkNegation :: Num a => Eq a => [[a]] -> Bool
checkNegation = and . map (and . (zipWith (\x y -> 0 /= (x + y)) <*> tail)) . allDiags
where
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
λ> checkNegation [[0,2,1], [3,1,-2], [3,-1,3]]
False
λ> checkNegation [[1,2], [-1,3]]
True
If you have a matrix like this and want to compare adjacent diagonal elements:
m = [[ 1, 2, 3, 4]
,[ 5, 6, 7, 8]
,[ 9,10,11,12]]
then you want to make two comparisons. First, you want to compare, element by element, the sub-matrix you get by dropping the first row and first column (left) with the sub-matrix you get by dropping the last row and last column (right):
[[ 6, 7, 8] [[ 1, 2, 3]
,[10,11,12] ,[ 5, 6, 7]]
Second, you want to compare, element by element, the sub-matrix you get by dropping the first row and last column (left) with the sub-matrix you get by dropping the last row and first column (right):
[[ 5, 6, 7] [[ 2, 3, 4]
,[ 9,10,11]] ,[ 6, 7, 8]]
We can construct these submatrices using init, tail, and maps of these:
m1 = tail (map tail m) -- drop first row and first column
m2 = init (map init m) -- drop last row and last column
m3 = tail (map init m) -- drop first row and last column
m4 = init (map tail m) -- drop last row and first column
giving:
λ> m1
[[6,7,8],[10,11,12]]
λ> m2
[[1,2,3],[5,6,7]]
λ> m3
[[5,6,7],[9,10,11]]
λ> m4
[[2,3,4],[6,7,8]]
How do we compare two sub-matrices? Well, we can write a two-dimensional version of zipWith to apply a binary function (a comparison, say) element by element to two matrices, the same way zipWith applies a binary function element by element to two lists:
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith zipRow m1 m2
where zipRow r1 r2 = zipWith f r1 r2
This works by zipping the matrices together, row by row, using the zipRow helper function. For each pair of rows, zipRow zips the rows together, element by element, with the function f. This definition can be simplified to the slightly less clear:
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
Anyway, to check if corresponding pairs of elements in two matrices are negatives of each other, we can use zipZipWith isNeg where:
isNeg :: (Num a, Eq a) => a -> a -> Bool
isNeg x y = x == -y
Then, to check if any of these pairs are negatives, we can use concat to change the matrix of booleans into a long list and or to check for any True values:
anyNegPairs :: (Num a, Eq a) => [[a]] -> [[a]] -> Bool
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
Finally, then, a complete function to perform the comparison would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
Since zipZipWith, like zipWith, ignores "extra" elements when comparing arguments of different sizes, it's not actually necessary to trim off the last column/row, so the sub-matrix definitions can be simplified by removing all the inits:
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
We could actually write m1 in terms of m4 to save double-calculating map tail m:
m1 = tail m4
but the compiler is smart enough to figure this out on its own.
So, a reasonable final solution would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
where
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
isNeg x y = x == -y
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
and it seems to work as desired on the test cases:
λ> noDiagNeg [[1,2],[-2,3]]
False
λ> noDiagNeg [[1,2],[3,-1]]
False
λ> noDiagNeg [[1,2],[-1,3]]
True
λ> noDiagNeg [[0,2,1],[3,1,-2],[3,-1,3]]
False
This is quite similar to #oisdk's solution, though this version might be easier to understand if you aren't too familiar with folds yet.
It fails on (certain) matrices with no elements:
λ> noDiagNeg []
*** Exception: Prelude.tail: empty list
λ> noDiagNeg [[],[]]
*** Exception: Prelude.tail: empty list
so you could use #oisdk's technique of replacing tail with drop 1, if this is a problem. (Actually, I might define tail' = drop 1 as a helper and replace all tail calls with tail' calls, since that would look a little nicer.)
First we pair up the rows: first with second, then second with third, then third with fourth, and so on.
Then, for each pair of rows, we consider all wedge-shaped triples of cells, like this:
--*---
-*-*--
So that the bottom-row cells are diagonally adjacent to the top-row ones.
Then we just check if any of the bottom ones are a negative of the top.
Except this has (literally) an edge case: beginnings and ends of the rows. If we do this wedge-shaped triple thing, we're going to miss the first and the last elements of the top row. To get around this, we first wrap the whole matrix in Just and then extend each row with Nothings on left and right:
[a,b,c] ==> [Nothing, Just a, Just b, Just c, Nothing]
[d,e,f] ==> [Nothing, Just d, Just e, Just f, Nothing]
Now we can safely iterate in triples and not miss anything.
checkNegation :: [[Int]] -> Bool
checkNegation matrix = any rowPairHasNegation rowPairs
where
extendedMatrix = map extendRow matrix
extendRow row = [Nothing] ++ map Just row ++ [Nothing]
rowPairs = extendedMatrix `zip` drop 1 extendedMatrix
rowPairHasNegation (row, nextRow) =
any cellTripleHasNegation $
drop 1 row `zip` nextRow `zip` drop 2 nextRow
cellTripleHasNegation ((x1y0, x0y1), x2y1) =
isNegation x1y0 x0y1 || isNegation x1y0 x2y1
isNegation (Just a) (Just b) = a == -b
isNegation _ _ = False
As far as I understand, this will result in iterating over the whole matrix exactly thrice - once as top row and twice as bottom row, meaning O(n*m)
I am trying to count the number of non-empty lists in a list of lists with recursive code.
My goal is to write something simple like:
prod :: Num a => [a] -> a
prod [] = 1
prod (x:xs) = x * prod xs
I already have the deifniton and an idea for the edge condition:
nonEmptyCount :: [[a]] -> Int
nonEmptyCount [[]] = 0
I have no idea how to continue, any tips?
I think your base case, can be simplified. As a base-case, we can take the empty list [], not a singleton list with an empty list. For the recursive case, we can consider (x:xs). Here we will need to make a distinction between x being an empty list, and x being a non-empty list. We can do that with pattern matching, or with guards:
nonEmptyCount :: [[a]] -> Int
nonEmptyCount [] = 0
nonEmptyCount (x:xs) = -- …
That being said, you do not need recursion at all. You can first filter your list, to omit empty lists, and then call length on that list:
nonEmptyCount :: [[a]] -> Int
nonEmptyCount = length . filter (…)
here you still need to fill in ….
Old fashion pattern matching should be:
import Data.List
nonEmptyCount :: [[a]] -> Int
nonEmptyCount [] = 0
nonEmptyCount (x:xs) = if null x then 1 + (nonEmptyCount xs) else nonEmptyCount xs
The following was posted in a comment, now deleted:
countNE = sum<$>(1<$)<<<(>>=(1`take`))
This most certainly will look intimidating to the non-initiated, but actually, it is equivalent to
= sum <$> (1 <$) <<< (>>= (1 `take`))
= sum <$> (1 <$) . (take 1 =<<)
= sum . fmap (const 1) . concatMap (take 1)
= sum . map (const 1) . concat . map (take 1)
which is further equivalent to
countNE xs = sum . map (const 1) . concat $ map (take 1) xs
= sum . map (const 1) $ concat [take 1 x | x <- xs]
= sum . map (const 1) $ [ r | x <- xs, r <- take 1 x]
= sum $ [const 1 r | (y:t) <- xs, r <- take 1 (y:t)] -- sneakiness!
= sum [const 1 r | (y:_) <- xs, r <- [y]]
= sum [const 1 y | (y:_) <- xs]
= sum [ 1 | (_:_) <- xs] -- replace each
-- non-empty list
-- in
-- xs
-- with 1, and
-- sum all the 1s up!
= (length . (take 1 =<<)) xs
= (length . filter (not . null)) xs
which should be much clearer, even if in a bit sneaky way. It isn't recursive in itself, yes, but both sum and the list-comprehension would be implemented recursively by a given Haskell implementation.
This reimplements length as sum . (1 <$), and filter p xs as [x | x <- xs, p x], and uses the equivalence not (null xs) === (length xs) >= 1.
See? Haskell is fun. Even if it doesn't yet feel like it, but it will be. :)
I've been working with problems (such as pentagonal numbers) that involve generating a list based on the previous elements in the list. I can't seem to find a built-in function of the form I want. Essentially, I'm looking for a function of the form:
([a] -> a) -> [a] -> [a]
Where ([a] -> a) takes the list so far and yields the next element that should be in the list and a or [a] is the initial list. I tried using iterate to achieve this, but that yields a list of lists, which each successive list having one more element (so to get the 3000th element I have to do (list !! 3000) !! 3000) instead of list !! 3000.
If the recurrence depends on a constant number of previous terms, then you can define the series using standard corecursion, like with the fibonacci sequence:
-- fibs(0) = 1
-- fibs(1) = 1
-- fibs(n+2) = fibs(n) + fibs(n+1)
fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
-- foos(0) = -1
-- foos(1) = 0
-- foos(2) = 1
-- foos(n+3) = foos(n) - 2*foos(n+1) + foos(n+2)
foos = -1 : 0 : 1 : zipWith (+) foos
(zipWith (+)
(map (negate 2 *) (tail foos))
(tail $ tail foos))
Although you can introduce some custom functions to make the syntax a little nicer
(#) = flip drop
infixl 7 #
zipMinus = zipWith (-)
zipPlus = zipWith (+)
-- foos(1) = 0
-- foos(2) = 1
-- foos(n+3) = foos(n) - 2*foos(n+1) + foos(n+2)
foos = -1 : 0 : 1 : ( ( foos # 0 `zipMinus` ((2*) <$> foos # 1) )
`zipPlus` foos # 2 )
However, if the number of terms varies, then you'll need a different approach.
For example, consider p(n), the number of ways in which a given positive integer can be expressed as a sum of positive integers.
p(n) = p(n-1) + p(n-2) - p(n-5) - p(n-7) + p(n-12) + p(n-15) - ...
We can define this more simply as
p(n) = ∑ k ∈ [1,n) q(k) p(n-k)
Where
-- q( i ) | i == (3k^2+5k)/2 = (-1) ^ k
-- | i == (3k^2+7k+2)/2 = (-1) ^ k
-- | otherwise = 0
q = go id 1
where go zs c = zs . zs . (c:) . zs . (c:) $ go ((0:) . zs) (negate c)
ghci> take 15 $ zip [1..] q
[(1,1),(2,1),(3,0),(4,0),(5,-1),(6,0),(7,-1),(8,0),(9,0),(10,0),(11,0),(12,1),
(13,0),(14,0),(15,1)]
Then we could use iterate to define p:
p = map head $ iterate next [1]
where next xs = sum (zipWith (*) q xs) : xs
Note how iterate next creates a series of reversed prefixes of p to make it easy to use q to calculate the next element of p. We then take the head element of each of these reversed prefixes to find p.
ghci> next [1]
[1,1]
ghci> next it
[2,1,1]
ghci> next it
[3,2,1,1]
ghci> next it
[5,3,2,1,1]
ghci> next it
[7,5,3,2,1,1]
ghci> next it
[11,7,5,3,2,1,1]
ghci> next it
[15,11,7,5,3,2,1,1]
ghci> next it
[22,15,11,7,5,3,2,1,1]
Abstracting this out to a pattern, we can get the function you were looking for:
construct :: ([a] -> a) -> [a] -> [a]
construct f = map head . iterate (\as -> f as : as)
p = construct (sum . zipWith (*) q) [1]
Alternately, we could do this in the standard corecursive style if we define a helper function to generate the reversed prefixes of a list:
rInits :: [a] -> [[a]]
rInits = scanl (flip (:)) []
p = 1 : map (sum . zipWith (*) q) (tail $ rInits p)
What's the most direct/efficient way to create all possibilities of dividing one (even) list into two in Haskell? I toyed with splitting all permutations of the list but that would add many extras - all the instances where each half contains the same elements, just in a different order. For example,
[1,2,3,4] should produce something like:
[ [1,2], [3,4] ]
[ [1,3], [2,4] ]
[ [1,4], [2,3] ]
Edit: thank you for your comments -- the order of elements and the type of the result is less important to me than the concept - an expression of all two-groups from one group, where element order is unimportant.
Here's an implementation, closely following the definition.
The first element always goes into the left group. After that, we add the next head element into one, or the other group. If one of the groups becomes too big, there is no choice anymore and we must add all the rest into the the shorter group.
divide :: [a] -> [([a], [a])]
divide [] = [([],[])]
divide (x:xs) = go ([x],[], xs, 1,length xs) []
where
go (a,b, [], i,j) zs = (a,b) : zs -- i == lengh a - length b
go (a,b, s#(x:xs), i,j) zs -- j == length s
| i >= j = (a,b++s) : zs
| (-i) >= j = (a++s,b) : zs
| otherwise = go (x:a, b, xs, i+1, j-1) $ go (a, x:b, xs, i-1, j-1) zs
This produces
*Main> divide [1,2,3,4]
[([2,1],[3,4]),([3,1],[2,4]),([1,4],[3,2])]
The limitation of having an even length list is unnecessary:
*Main> divide [1,2,3]
[([2,1],[3]),([3,1],[2]),([1],[3,2])]
(the code was re-written in the "difference-list" style for efficiency: go2 A zs == go1 A ++ zs).
edit: How does this work? Imagine yourself sitting at a pile of stones, dividing it into two. You put the first stone to a side, which one it doesn't matter (so, left, say). Then there's a choice where to put each next stone — unless one of the two piles becomes too small by comparison, and we thus must put all the remaining stones there at once.
To find all partitions of a non-empty list (of even length n) into two equal-sized parts, we can, to avoid repetitions, posit that the first element shall be in the first part. Then it remains to find all ways to split the tail of the list into one part of length n/2 - 1 and one of length n/2.
-- not to be exported
splitLen :: Int -> Int -> [a] -> [([a],[a])]
splitLen 0 _ xs = [([],xs)]
splitLen _ _ [] = error "Oops"
splitLen k l ys#(x:xs)
| k == l = [(ys,[])]
| otherwise = [(x:us,vs) | (us,vs) <- splitLen (k-1) (l-1) xs]
++ [(us,x:vs) | (us,vs) <- splitLen k (l-1) xs]
does that splitting if called appropriately. Then
partitions :: [a] -> [([a],[a])]
partitions [] = [([],[])]
partitions (x:xs)
| even len = error "Original list with odd length"
| otherwise = [(x:us,vs) | (us,vs) <- splitLen half len xs]
where
len = length xs
half = len `quot` 2
generates all the partitions without redundantly computing duplicates.
luqui raises a good point. I haven't taken into account the possibility that you'd want to split lists with repeated elements. With those, it gets a little more complicated, but not much. First, we group the list into equal elements (done here for an Ord constraint, for only Eq, that could still be done in O(length²)). The idea is then similar, to avoid repetitions, we posit that the first half contains more elements of the first group than the second (or, if there is an even number in the first group, equally many, and similar restrictions hold for the next group etc.).
repartitions :: Ord a => [a] -> [([a],[a])]
repartitions = map flatten2 . halves . prepare
where
flatten2 (u,v) = (flatten u, flatten v)
prepare :: Ord a => [a] -> [(a,Int)]
prepare = map (\xs -> (head xs, length xs)) . group . sort
halves :: [(a,Int)] -> [([(a,Int)],[(a,Int)])]
halves [] = [([],[])]
halves ((a,k):more)
| odd total = error "Odd number of elements"
| even k = [((a,low):us,(a,low):vs) | (us,vs) <- halves more] ++ [normalise ((a,c):us,(a,k-c):vs) | c <- [low + 1 .. min half k], (us,vs) <- choose (half-c) remaining more]
| otherwise = [normalise ((a,c):us,(a,k-c):vs) | c <- [low + 1 .. min half k], (us,vs) <- choose (half-c) remaining more]
where
remaining = sum $ map snd more
total = k + remaining
half = total `quot` 2
low = k `quot` 2
normalise (u,v) = (nz u, nz v)
nz = filter ((/= 0) . snd)
choose :: Int -> Int -> [(a,Int)] -> [([(a,Int)],[(a,Int)])]
choose 0 _ xs = [([],xs)]
choose _ _ [] = error "Oops"
choose need have ((a,k):more) = [((a,c):us,(a,k-c):vs) | c <- [least .. most], (us,vs) <- choose (need-c) (have-k) more]
where
least = max 0 (need + k - have)
most = min need k
flatten :: [(a,Int)] -> [a]
flatten xs = xs >>= uncurry (flip replicate)
Daniel Fischer's answer is a good way to solve the problem. I offer a worse (more inefficient) way, but one which more obviously (to me) corresponds to the problem description. I will generate all partitions of the list into two equal length sublists, then filter out equivalent ones according to your definition of equivalence. The way I usually solve problems is by starting like this -- create a solution that is as obvious as possible, then gradually transform it into a more efficient one (if necessary).
import Data.List (sort, nubBy, permutations)
type Partition a = ([a],[a])
-- Your notion of equivalence (sort to ignore the order)
equiv :: (Ord a) => Partition a -> Partition a -> Bool
equiv p q = canon p == canon q
where
canon (xs,ys) = sort [sort xs, sort ys]
-- All ordered partitions
partitions :: [a] -> [Partition a]
partitions xs = map (splitAt l) (permutations xs)
where
l = length xs `div` 2
-- All partitions filtered out by the equivalence
equivPartitions :: (Ord a) => [a] -> [Partition a]
equivPartitions = nubBy equiv . partitions
Testing
>>> equivPartitions [1,2,3,4]
[([1,2],[3,4]),([3,2],[1,4]),([3,1],[2,4])]
Note
After using QuickCheck to test the equivalence of this implementation with Daniel's, I found an important difference. Clearly, mine requires an (Ord a) constraint and his does not, and this hints at what the difference would be. In particular, if you give his [0,0,0,0], you will get a list with three copies of ([0,0],[0,0]), whereas mine will give only one copy. Which of these is correct was not specified; Daniel's is natural when considering the two output lists to be ordered sequences (which is what that type is usually considered to be), mine is natural when considering them as sets or bags (which is how this question seemed to be treating them).
Splitting The Difference
It is possible to get from an implementation that requires Ord to one that doesn't, by operating on the positions rather than the values in a list. I came up with this transformation -- an idea which I believe originates with Benjamin Pierce in his work on bidirectional programming.
import Data.Traversable
import Control.Monad.Trans.State
data Labelled a = Labelled { label :: Integer, value :: a }
instance Eq (Labelled a) where
a == b = compare a b == EQ
instance Ord (Labelled a) where
compare a b = compare (label a) (label b)
labels :: (Traversable t) => t a -> t (Labelled a)
labels t = evalState (traverse trav t) 0
where
trav x = state (\i -> i `seq` (Labelled i x, i + 1))
onIndices :: (Traversable t, Functor u)
=> (forall a. Ord a => t a -> u a)
-> forall b. t b -> u b
onIndices f = fmap value . f . labels
Using onIndices on equivPartitions wouldn't speed it up at all, but it would allow it to have the same semantics as Daniel's (up to equiv of the results) without the constraint, and with my more naive and obvious way of expressing it -- and I just thought it was an interesting way to get rid of the constraint.
My own generalized version, added much later, inspired by Will's answer:
import Data.Map (adjust, fromList, toList)
import Data.List (groupBy, sort)
divide xs n evenly = divide' xs (zip [0..] (replicate n [])) where
evenPSize = div (length xs) n
divide' [] result = [result]
divide' (x:xs) result = do
index <- indexes
divide' xs (toList $ adjust (x :) index (fromList result)) where
notEmptyBins = filter (not . null . snd) $ result
partlyFullBins | evenly == "evenly" = map fst . filter ((<evenPSize) . length . snd) $ notEmptyBins
| otherwise = map fst notEmptyBins
indexes = partlyFullBins
++ if any (null . snd) result
then map fst . take 1 . filter (null . snd) $ result
else if null partlyFullBins
then map fst. head . groupBy (\a b -> length (snd a) == length (snd b)) . sort $ result
else []
I've just started learning about Functional Programming, using Haskel.
I'm slowly getting through Erik Meijer's lectures on Channel 9 (I've watched the first 4 so far) and in the 4th video Erik explains how tail works, and it fascinated me.
I've tried to write a function that returns the middle of a list (2 items for even lengths, 1 for odd) and I'd like to hear how others would implement it in
The least amount of Haskell code
The fastest Haskell code
If you could explain your choices I'd be very grateful.
My beginners code looks like this:
middle as | length as > 2 = middle (drop 2 (reverse as))
| otherwise = as
Just for your amusement, a solution from someone who doesn't speak Haskell:
Write a recursive function that takes two arguments, a1 and a2, and pass your list in as both of them. At each recursion, drop 2 from a2 and 1 from a1. If you're out of elements for a2, you'll be at the middle of a1. You can handle the case of just 1 element remaining in a2 to answer whether you need 1 or 2 elements for your "middle".
I don't make any performance claims, though it only processes the elements of the list once (my assumption is that computing length t is an O(N) operation, so I avoid it), but here's my solution:
mid [] = [] -- Base case: the list is empty ==> no midpt
mid t = m t t -- The 1st t is the slow ptr, the 2nd is fast
where m (x:_) [_] = [x] -- Base case: list tracked by the fast ptr has
-- exactly one item left ==> the first item
-- pointed to by the slow ptr is the midpt.
m (x:y:_) [_,_] = [x,y] -- Base case: list tracked by the fast ptr has
-- exactly two items left ==> the first two
-- items pointed to by the slow ptr are the
-- midpts
m (_:t) (_:_:u) = m t u -- Recursive step: advance slow ptr by 1, and
-- advance fast ptr by 2.
The idea is to have two "pointers" into the list, one that increments one step at each point in the recursion, and one that increments by two.
(which is essentially what Carl Smotricz suggested)
Two versions
Using pattern matching, tail and init:
middle :: [a] -> [a]
middle l#(_:_:_:_) = middle $ tail $ init l
middle l = l
Using length, take, signum, mod, drop and div:
middle :: [a] -> [a]
middle xs = take (signum ((l + 1) `mod` 2) + 1) $ drop ((l - 1) `div ` 2) xs
where l = length xs
The second one is basically a one-liner (but uses where for readability).
I've tried to write a function that returns the middle of a list (2 items for even lengths, 1 for odd) and I'd like to hear how others would implement it in
The right datastructure for the right problem. In this case, you've specified something that only makes sense on a finite list, right? There is no 'middle' to an infinite list. So just reading the description, we know that the default Haskell list may not be the best solution: we may be paying the price for the laziness even when we don't need it. Notice how many of the solutions have difficulty avoiding 2*O(n) or O(n). Singly-linked lazy lists just don't match a quasi-array-problem too well.
Fortunately, we do have a finite list in Haskell: it's called Data.Sequence.
Let's tackle it the most obvious way: 'index (length / 2)'.
Data.Seq.length is O(1) according to the docs. Data.Seq.index is O(log(min(i,n-i))) (where I think i=index, and n=length). Let's just call it O(log n). Pretty good!
And note that even if we don't start out with a Seq and have to convert a [a] into a Seq, we may still win. Data.Seq.fromList is O(n). So if our rival was a O(n)+O(n) solution like xs !! (length xs), a solution like
middle x = let x' = Seq.fromList x in Seq.index(Seq.length x' `div` 2)
will be better since it would be O(1) + O(log n) + O(n), which simplifies to O(log n) + O(n), obviously better than O(n)+O(n).
(I leave as an exercise to the reader modifying middle to return 2 items if length be even and 1 if length be odd. And no doubt one could do better with an array with constant-time length and indexing operations, but an array isn't a list, I feel.)
Haskell solution inspired by Carl's answer.
middle = m =<< drop 1
where m [] = take 1
m [_] = take 2
m (_:_:ys) = m ys . drop 1
If the sequence is a linked list, traversal of this list is the dominating factor of efficiency. Since we need to know the overall length, we have to traverse the list at least once. There are two equivalent ways to get the middle elements:
Traverse the list once to get the length, then traverse it half to get at the middle elements.
Traverse the list in double steps and single steps at the same time, so that when the first traversal stops, the second traversal is in the middle.
Both need the same number of steps. The second is needlessly complicated, in my opinion.
In Haskell, it might be something like this:
middle xs = take (2 - r) $ drop ((div l 2) + r - 1) xs
where l = length xs
r = rem l 2
middle xs =
let (ms, len) = go xs 0 [] len
in ms
go (x:xs) i acc len =
let acc_ = case len `divMod` 2 of
(m, 0) -> if m == (i+1) then (take 2 (x:xs))
else acc
(m, 1) -> if m == i then [x]
else acc
in go xs (i+1) acc_ len
go [] i acc _ = (acc,i)
This solution traverses the list just once using lazy evaluation. While it traverses the list, it calculates the length and then backfeeds it to the function:
let (ms, len) = go xs 0 [] len
Now the middle elements can be calculated:
let acc' = case len `divMod` 2 of
...
F# solution based on Carl's answer:
let halve_list l =
let rec loop acc1 = function
| x::xs, [] -> List.rev acc1, x::xs
| x::xs, [y] -> List.rev (x::acc1), xs
| x::xs, y::y'::ys -> loop (x::acc1) (xs, ys)
| [], _ -> [], []
loop [] (l, l)
It's pretty easy to modify to get the median elements in the list too:
let median l =
let rec loop acc1 = function
| x::xs, [] -> [List.head acc1; x]
| x::xs, [y] -> [x]
| x::xs, y::y'::ys -> loop (x::acc1) (xs, ys)
| [], _ -> []
loop [] (l, l)
A more intuitive approach uses a counter:
let halve_list2 l =
let rec loop acc = function
| (_, []) -> [], []
| (0, rest) -> List.rev acc, rest
| (n, x::xs) -> loop (x::acc) (n - 1, xs)
let count = (List.length l) / 2
loop [] (count, l)
And a really ugly modification to get the median elements:
let median2 l =
let rec loop acc = function
| (n, [], isEven) -> []
| (0, rest, isEven) ->
match rest, isEven with
| x::xs, true -> [List.head acc; x]
| x::xs, false -> [x]
| _, _ -> failwith "Should never happen"
| (n, x::xs, isEven) -> loop (x::acc) (n - 1, xs, isEven)
let len = List.length l
let count = len / 2
let isEven = if len % 2 = 0 then true else false
loop [] (count, l, isEven)
Getting the length of a list requires traversing its entire contents at least once. Fortunately, it's perfectly easy to write your own list data structure which holds the length of the list in each node, allowing you get get the length in O(1).
Weird that this perfectly obvious formulation hasn't come up yet:
middle [] = []
middle [x] = [x]
middle [x,y] = [x,y]
middle xs = middle $ init $ tail xs
A very straightforward, yet unelegant and not so terse solution might be:
middle :: [a] -> Maybe [a]
middle xs
| len <= 2 = Nothing
| even len = Just $ take 2 . drop (half - 1) $ xs
| odd len = Just $ take 1 . drop (half) $ xs
where
len = length xs
half = len `div` 2
This iterates twice over the list.
mid xs = m where
l = length xs
m | l `elem` [0..2] = xs
m | odd l = drop (l `div` 2) $ take 1 $ xs
m | otherwise = drop (l `div` 2 - 1) $ take 2 $ xs
I live for one liners, although this example only works for odd lists. I just want to stretch my brain! Thank you for the fun =)
foo d = map (\(Just a) -> a) $ filter (/=Nothing) $ zipWith (\a b -> if a == b then Just a else Nothing) (Data.List.nub d) (Data.List.nub $ reverse d)
I'm not much of a haskeller myself but I tried this one.
First the tests (yes, you can do TDD using Haskell)
module Main
where
import Test.HUnit
import Middle
main = do runTestTT tests
tests = TestList [ test1
, test2
, test3
, test4
, test_final1
, test_final2
]
test1 = [0] ~=? middle [0]
test2 = [0, 1] ~=? middle [0, 1]
test3 = [1] ~=? middle [0, 1, 2]
test4 = [1, 2] ~=? middle [0, 1, 2, 3]
test_final1 = [3] ~=? middle [0, 1, 2, 3, 4, 5, 6]
test_final2 = [3, 4] ~=? middle [0, 1, 2, 3, 4, 5, 6, 7]
And the solution I came to:
module Middle
where
middle a = midlen a (length a)
midlen (a:xs) 1 = [a]
midlen (a:b:xs) 2 = [a, b]
midlen (a:xs) lg = midlen xs (lg - (2))
It will traverse list twice, once for getting length and a half more to get the middle, but I don't care it's still O(n) (and getting the middle of something implies to get it's length, so no reason to avoid it).
My solution, I like to keep things simple:
middle [] = []
middle xs | odd (length xs) = [xs !! ((length xs) `div` 2)]
| otherwise = [(xs !! ((length xs) `div` 2)),(reverse $ xs) !! ((length xs)`div` 2)]
Use of !! in Data.List as the function to get the value at a given index, which in this case is half the length of the list.
Edit: it actually works now
I like Svante's answer. My version:
> middle :: [a] -> [a]
> middle [] = []
> middle xs = take (r+1) . drop d $ xs
> where
> (d,r) = (length xs - 1) `divMod` 2
Here is my version. It was just a quick run up. I'm sure it's not very good.
middleList xs#(_:_:_:_) = take (if odd n then 1 else 2) $ drop en xs
where n = length xs
en = if n < 5 then 1 else 2 * (n `div` 4)
middleList xs = xs
I tried. :)
If anyone feels like commenting and telling me how awful or good this solution is, I would deeply appreciate it. I'm not very well versed in Haskell.
EDIT: Improved with suggestions from kmc on #haskell-blah
EDIT 2: Can now accept input lists with a length of less than 5.
Another one-line solution:
--
middle = ap (take . (1 +) . signum . (`mod` 2) . (1 +) . length) $ drop =<< (`div` 2) . subtract 1 . length
--