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)
Related
I want to rewrite (or upgrade! :) ) my two functions, hist and sort, using fold-functions. But since I am only in the beginning of my Haskell-way, I can't figure out how to do it.
First of all, I have defined Insertion, Table and imported Data.Char:
type Insertion = (Char, Int)
type Table = [Insertion]
import Data.Char
Then I have implemented the following code for hist:
hist :: String -> Table
hist[] = []
hist(x:xs) = sortBy x (hist xs) where
sortBy x [] = [(x,1)]
sortBy x ((y,z):yzs)
| x == y = (y,z+1) : yzs
| otherwise = (y,z) : sortBy x yzs
And this one for sort:
sort :: Ord a => [a] -> [a]
sort [] = []
sort (x:xs) = paste x (sort xs)
paste :: Ord a => a -> [a] -> [a]
paste y [] = [y]
paste y (x:xs)
| x < y = x : paste y xs
| otherwise = y : x : xs
What can I do next? How can I use the fold-functions to implement them?
foldr f z on a list replaces the "cons" of the list (:) with f and the empty list [] with z.
This thus means that for a list like [1,4,2,5], we thus obtain f 1 (f 4 (f 2 (f 5 z))), since [1,4,2,5] is short for 1 : 4 : 2 : 5 : [] or more canonical (:) 1 ((:) 4 ((:) 2 ((:) 5 []))).
The sort function for example can be replaced with a fold function:
sort :: Ord a => [a] -> [a]
sort = foldr paste []
since sort [1,4,2,5] is equivalent to paste 1 (paste 4 (paste 2 (paste 5 []))). Here f thus takes as first parameter an element, and as second parameter the result of calling foldr f z on the rest of the list,
I leave hist as an exercise.
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. :)
This is for a class
We're supposed to write 3 functions :
1 : Prints list of fibbonaci numbers
2 : Prints list of prime numbers
3 : Prints list of fibonacci numbers whose indexes are prime
EG : Let this be fibbonaci series
Then In partC - certain elements are only shown
1: 1
*2: 1 (shown as index 2 is prime )
*3: 2 (shown as index 3 is prime )
4: 3
*5: 5 (shown )
6: 8
*7: 13 (shown as index 7 prime and so on)
I'm done with part 1 & 2 but I'm struggling with part 3. I created a function listNum that creates a sort of mapping [Integer, Integer] from the Fibbonaci series - where 1st Int is the index and 2nd int is the actual fibbonaci numbers.
Now my function partC is trying to stitch snd elements of the fibonaci series by filtering the indexes but I'm doing something wrong in the filter step.
Any help would be appreciated as I'm a beginner to Haskell.
Thanks!
fib :: [Integer]
fib = 0 : 1 : zipWith (+) fib (tail fib)
listNum :: [(Integer, Integer)]
listNum = zip [1 .. ] fib
primes :: [Integer]
primes = sieve (2 : [3,5 ..])
where
sieve (p:xs) = p : sieve [x | x <- xs , x `mod` p > 0]
partC :: [Integer] -- Problem in filter part of this function
partC = map snd listNum $ filter (\x -> x `elem` primes) [1,2 ..]
main = do
print (take 10 fib) -- Works fine
print (take 10 primes) --works fine
print (take 10 listNum) --works fine
print ( take 10 partC) -- Causes error
Error :
prog0.hs:14:9: error:
• Couldn't match expected type ‘[Integer] -> [Integer]’
with actual type ‘[Integer]’
• The first argument of ($) takes one argument,
but its type ‘[Integer]’ has none
In the expression:
map snd listNum $ filter (\ x -> x `elem` primes) [1, 2 .. ]
In an equation for ‘partC’:
partC
= map snd listNum $ filter (\ x -> x `elem` primes) [1, 2 .. ]
|
14 | partC = map snd listNum $ filter (\x -> x `elem` primes) [1,2 ..]
Here's what I think you intended as the original logic of partC. You got the syntax mostly right, but the logic has a flaw.
partC = snd <$> filter ((`elem` primes) . fst) (zip [1..] fib)
-- note that (<$>) = fmap = map, just infix
-- list comprehension
partC = [fn | (idx, fn) <- zip [1..] fib, idx `elem` primes]
But this cannot work. As #DanRobertson notes, you'll try to check 4 `elem` primes and run into an infinite loop, because primes is infinite and elem tries to be really sure that 4 isn't an element before giving up. We humans know that 4 isn't an element of primes, but elem doesn't.
There are two ways out. We can write a custom version of elem that gives up once it finds an element larger than the one we're looking for:
sortedElem :: Ord a => a -> [a] -> Bool
sortedElem x (h:tl) = case x `compare` h of
LT -> False
EQ -> True
GT -> sortedElem x tl
sortedElem _ [] = False
-- or
sortedElem x = foldr (\h tl -> case x `compare` h of
LT -> False
EQ -> True
GT -> tl
) False
Since primes is a sorted list, sortedElem will always give the correct answer now:
partC = snd <$> filter ((`sortedElem` primes) . fst) (zip [1..] fib)
However, there is a performance issue, because every call to sortedElem has to start at the very beginning of primes and walk all the way down until it figures out whether or not the index is right. This leads into the second way:
partC = go primeDiffs fib
where primeDiffs = zipWith (-) primes (1:primes)
-- primeDiffs = [1, 1, 2, 2, 4, 2, 4, 2, 4, 6, ...]
-- The distance from one prime (incl. 1) to the next
go (step:steps) xs = x:go steps xs'
where xs'#(x:_) = drop step xs
go [] _ = [] -- unused here
-- in real code you might pull this out into an atOrderedIndices :: [Int] -> [a] -> [a]
We transform the list of indices (primes) into a list of offsets, each one building on the next, and we call it primeDiffs. We then define go to take such a list of offsets and extract elements from another list. It first drops the elements being skipped, and then puts the top element into the result before building the rest of the list. Under -O2, on my machine, this version is twice as fast as the other one when finding partC !! 5000.
I have list of lists of Int and I need to add an Int value to the last list from the list of lists. How can I do this? My attempt is below
f :: [[Int]] -> [Int] -> Int -> Int -> Int -> [[Int]]
f xs [] cur done total = [[]]
f xs xs2 cur done total = do
if total >= length xs2 then
xs
else
if done == fib cur then
f (xs ++ [[]]) xs2 (cur + 1) 0 total
else
f ((last xs) ++ [[xs2!!total]]) xs2 cur (done + 1) (total + 1)
The problem is:
We have a list A of Int
And we need to slpit it on N lists B_1 ,..., B_n , length of B_i is i-th Fibonacci number.
If we have list [1 , 2 , 3 , 4 , 5 , 6 , 7] (xs2 in my code)
The result should be [[1] , [2] , [3 , 4] , [5 , 6 , 7]]
The easy way to deal with problems like this is to separate the problem into sub-problems. In this case, you want to change the last item in a list. The way you want to change it is by adding an item to it.
First let's tackle changing the last item of a list. We'll do this by applying a function to the last item, but not to any other items.
onLast :: [a] -> (a -> a) -> [a]
onLast xs f = go xs
where
go [] = []
go [x] = [f x]
go (x:xs) = x:go xs
You want to change the last item in the list by adding an additional value, which you can do with (++ [value]).
Combining the two with the value you want to add (xs2!!total) we get
(onLast xs (++ [xs2!!total]))
f :: [[Int]] -> Int -> [[Int]]
f [] _ = []
f xs i = (take n xs) ++ [[x + i | x <- last xs]]
where n = (length xs) - 1
last = head . (drop n)
For example,
*Main> f [[1, 2, 3], [], [4, 5, 6]] 5
[[1,2,3],[],[9,10,11]]
*Main> f [[1, 2, 3]] 5
[[6,7,8]]
*Main> f [] 3
You approach uses a do block, this is kind of weird since do blocks are usually used for monads. Furthermore it is rather unclear what cur, done and total are doing. Furthermore you use (!!) :: [a] -> Int -> a and length :: [a] -> Int. The problem with these functions is that these run in O(n), so it makes the code inefficient as well.
Based on changed specifications, you want to split the list in buckets with length the Fibonacci numbers. In that case the signature should be:
f :: [a] -> [[a]]
because as input you give a list of numbers, and as output, you return a list of numbers. We can then implement that as:
f :: [a] -> [[a]]
f = g 0 1
where g _ _ [] = []
g a b xs = xa : g b (a+b) xb
where (xa,xb) = splitAt b xs
This generates:
*Main> f [1,2,3,4,5,6]
[[1],[2],[3,4],[5,6]]
*Main> f [1,2,3,4,5,6,7]
[[1],[2],[3,4],[5,6,7]]
*Main> f [1,2,3,4,5,6,7,8]
[[1],[2],[3,4],[5,6,7],[8]]
*Main> f [1,2,3,4,5,6,7,8,9]
[[1],[2],[3,4],[5,6,7],[8,9]]
The code works as follows: we state that f = g 0 1 so we pass the arguments of f to g, but g also gets an 0 and a 1 (the first Fibonacci numbers).
Each iteration g checks whether we reached the end of the list. If so, we return an empty list as well. Otherwise we determine the last Fibonacci number that far (b), and use a splitAt to obtain the first b elements of the list we process, as well as the remainder. We then emit the first part as head of the list, and for the tail we calculate the next Fibonacci number and pass that to g with the tail of splitAt.
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 []