Haskell foldl implementation with foldr - haskell

I have troubles understanding the implementation of the foldl function using foldr. I have read this question (Writing foldl using foldr) and I still have some things I don't understand in the following example:
fun :: [Int] -> [Int]
fun l = foldr g (const []) l 1
where g x f lst = if gcd x lst == 1 then x : f x else f lst
The function takes a list as parameter and return another list where gcd(l[i], l[i + 1] = 1.
My questions are the following:
1. Who are x, f and lst
2. What is const[] and why I can't use the id function?

foldr is one of those weird tools like bicycles that are really easy to use once you get the hang of them but hard to learn from the start. After several years of experience, I've gotten really good at spotting problems I can solve with foldr, and solving them with it immediately and correctly, but it could easily take me a while to figure out what just what I've done in enough detail to explain!
From a practical standpoint, I usually think of foldr in vaguely continuation-passing language. Ignoring the "simple" case where foldr is only applied to three arguments, an application of foldr looks like this:
foldr go finish xs acc1 acc2 ... where
finish acc1 acc2 ... = ?
go x cont acc1 acc2 ... = ?
acc1, etc., are accumulators passed "from left to right". The result consists, conceptually, of a single value passed "from right to left".
finish gets the final values of the accumulators and produces something of the result type. It's usually the easiest part to write because
foldr go finish [] acc1 acc2 ...
=
finish acc1 acc2 ...
So once you figure out just what you want your fold to produce, writing finish is fairly mechanical.
go gets a single container element, a "continuation", and the accumulators. It passes modified values if those accumulators "forward" to the continuation to get a result, and uses that result to construct its own.
foldl is a particularly simple case because its go function just returns the result it gets from folding the rest of the container with a new accumulator argument. I think it's a bit more instructive to look at an example that does a bit more. Here's one that takes a container of numbers and produces a list of pairs representing a running sum and a running product.
sumsProducts :: (Num n, Foldable f) => f n -> [(n, n)]
sumsProducts xs = foldr go finish xs 0 1
where
finish total prod = [(total, prod)]
go x cont total prod =
(total, prod) : cont (x + total) (x * prod)

foldr's type signature is this
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
This means your foldr applied to its 3 arguments must return a function that takes the 1 as an argument.
So you can specialise your foldr to this
foldr :: (Int -> (Int -> [Int]) -> (Int -> [Int]))
-> (Int -> [Int])
-> [Int]
-> (Int -> [Int])
This means your g function must have the following type
g :: Int -> (Int -> [Int]) -> Int -> [Int]
So your parameters have the type
x :: Int
f :: Int -> [Int]
lst :: Int
And foldr in its 2nd argument requires a Int -> [Int] instead of just an Int, so you can't pass it the value [].
Fortunately const returns a function that ignores its argument and just always return a constant expression
const [] :: a -> [b]
In your case f is indeed some kind of accumulator. But instead of reducing e.g. a list of values to some number, you are chaining functions here. By passing 1 to this function chain in the end, it gets evaluated and is then building the actual list you return in fun.

Related

How to use the Select monad to solve n-queens?

I'm trying to understand how the Select monad works. Apparently, it is a cousin of Cont and it can be used for backtracking search.
I have this list-based solution to the n-queens problem:
-- All the ways of extracting an element from a list.
oneOf :: [Int] -> [(Int,[Int])]
oneOf [] = []
oneOf (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (oneOf xs)
-- Adding a new queen at col x, is it threathened diagonally by any of the
-- existing queens?
safeDiag :: Int -> [Int] -> Bool
safeDiag x xs = all (\(y,i) -> abs (x-y) /= i) (zip xs [1..])
nqueens :: Int -> [[Int]]
nqueens queenCount = go [] [1..queenCount]
where
-- cps = columsn of already positioned queens.
-- fps = columns that are still available
go :: [Int] -> [Int] -> [[Int]]
go cps [] = [cps]
go cps fps = [ps | (p,nfps) <- oneOf fps, ps <- go (p:cps) nfps, safeDiag p cps]
I'm struggling to adapt this solution to use Select instead.
It seems that Select lets you abstract over the "evaluation function" that is used to compare answers. That function is passed to runSelect. I have the feeling that something like safeDiag in my solution could work as the evaluation function, but how to structure the Select computation itself?
Also, is it enough to use the Select monad alone, or do I need to use the transformer version over lists?
I realize this is question is almost 4 years old and already has an answer, but I wanted to chime in with some additional information for the sake of anyone who comes across this question in the future. Specifically, I want to try to answer 2 questions:
how are multiple Selects that return single values combined to create a single Select that returns a sequence of values?
is it possible to return early when a solution path is destined to fail?
Chaining Selects
Select is implemented as a monad transformer in the transformers library (go figure), but let's take a look at how one might implement >>= for Select by itself:
(>>=) :: Select r a -> (a -> Select r b) -> Select r b
Select g >>= f = Select $ \k ->
let choose x = runSelect (f x) k
in choose $ g (k . choose)
We start by defining a new Select which takes an input k of type a -> r (recall that Select wraps a function of type (a -> r) -> a). You can think of k as a function that returns a "score" of type r for a given a, which the Select function may use to determine which a to return.
Inside our new Select, we define a function called choose. This function passes some x to the function f, which is the a -> m b portion of monadic binding: it transforms the result of the m a computation into a new computation m b. So f is going to take that x and return a new Select, which choose then runs using our scoring function k. You can think of choose as a function that asks "what would the final result be if I selected x and passed it downstream?"
On the second line, we return choose $ g (k . choose). The function k . choose is the composition of choose and our original scoring function k: it takes in a value, calculates the downstream result of selecting that value, and returns the score of that downstream result. In other words, we've created a kind of "clairvoyant" scoring function: instead of returning the score of a given value, it returns the score of the final result we would get if we selected that value. By passing in our "clairvoyant" scoring function to g (the original Select that we're binding to), we're able to select the intermediate value that leads to the final result we're looking for. Once we have that intermediate value, we simply pass it back into choose and return the result.
That's how we're able to string together single-value Selects while passing in a scoring function that operates on an array of values: each Select is scoring the hypothetical final result of selecting a value, not necessarily the value itself. The applicative instance follows the same strategy, the only difference being how the downstream Select is computed (instead of passing a candidate value into the a -> m b function, it maps a candidate function over the 2nd Select.)
Returning Early
So, how can we use Select while returning early? We need some way of accessing the scoring function within the scope of the code that constructs the Select. One way to do that is to construct each Select within another Select, like so:
sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain#(x:xs) = select $ \k ->
if k [] then runSelect s k else []
where
s = do
choice <- elementSelect (x:|xs)
fmap (choice:) $ sequenceSelect (filter (/= choice) domain)
This allows us to test the sequence in progress and short-circuit the recursion if it fails. (We can test the sequence by calling k [] because the scoring function includes all of the prepends that we've recursively lined up.)
Here's the whole solution:
import Data.List
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Trans.Select
validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
where
verify [] = True
verify (x:xs) = and $ zipWith (\i y -> x /= y && abs (x - y) /= i) [1..] xs
nqueens :: Int -> [Int]
nqueens boardSize = runSelect (sequenceSelect [1..boardSize]) validBoard
sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain#(x:xs) = select $ \k ->
if k [] then runSelect s k else []
where
s = do
choice <- elementSelect (x:|xs)
fmap (choice:) $ sequenceSelect (filter (/= choice) domain)
elementSelect :: NonEmpty a -> Select Bool a
elementSelect domain = select $ \p -> epsilon p domain
-- like find, but will always return something
epsilon :: (a -> Bool) -> NonEmpty a -> a
epsilon _ (x:|[]) = x
epsilon p (x:|y:ys) = if p x then x else epsilon p (y:|ys)
In short: we construct a Select recursively, removing elements from the domain as we use them and terminating the recursion if the domain has been exhausted or if we're on the wrong track.
One other addition is the epsilon function (based on Hilbert's epsilon operator). For a domain of size N it will check at most N - 1 items... it might not sound like a huge savings, but as you know from the above explanation, p will usually kick off the remainder of the entire computation, so it's best to keep predicate calls to a minimum.
The nice thing about sequenceSelect is how generic it is: it can be used to create any Select Bool [a] where
we're searching within a finite domain of distinct elements
we want to create a sequence that includes every element exactly once (i.e. a permutation of the domain)
we want to test partial sequences and abandon them if they fail the predicate
Hope this helps clarify things!
P.S. Here's a link to an Observable notebook in which I implemented the Select monad in Javascript along with a demonstration of the n-queens solver: https://observablehq.com/#mattdiamond/the-select-monad
Select can be viewed as an abstraction of a search in a "compact" space, guided by some predicate. You mentioned SAT in your comments, have you tried modelling the problem as a SAT instance and throw it at a solver based on Select (in the spirit of this paper)? You can specialise the search to hardwire the N-queens specific constraints inside your and turn the SAT solver into a N-queens solver.
Inspired by jd823592's answer, and after looking at the SAT example in the paper, I have written this code:
import Data.List
import Control.Monad.Trans.Select
validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
where
verify [] = True
verify (x : xs) = and $ zipWith (\i y -> x /= y && abs (x-y) /= i) [1..] xs
nqueens :: Int -> [Int]
nqueens boardSize = runSelect (traverse selectColumn columns) validBoard
where
columns = replicate boardSize [1..boardSize]
selectColumn candidates = select $ \s -> head $ filter s candidates ++ candidates
It seems to arrive (albeit slowly) to a valid solution:
ghci> nqueens 8
[1,5,8,6,3,7,2,4]
I don't understand it very well, however. In particular, the way sequence works for Select, transmuting a function (validBoard) that works over a whole board into functions that take a single column index, seems quite magical.
The sequence-based solution has the defect that putting a queen in a column doesn't rule out the possibility of choosing the same column for subsequent queens; we end up unnecesarily exploring doomed branches.
If we want our column choices to be affected by previous decisions, we need to go beyond Applicative and use the power of Monad:
nqueens :: Int -> [Int]
nqueens boardSize = fst $ runSelect (go ([],[1..boardSize])) (validBoard . fst)
where
go (cps,[]) = return (cps,[])
go (cps,fps) = (select $ \s ->
let candidates = map (\(z,zs) -> (z:cps,zs)) (oneOf fps)
in head $ filter s candidates ++ candidates) >>= go
The monadic version still has the problem that it only checks completed boards, when the original list-based solution backtracked as soon as a partially completed board was found to be have a conflict. I don't know how to do that using Select.

Recursive state monad for accumulating a value while building a list?

I'm totally new to Haskell so apologies if the question is silly.
What I want to do is recursively build a list while at the same time building up an accumulated value based on the recursive calls. This is for a problem I'm doing for a Coursera course, so I won't post the exact problem but something analogous.
Say for example I wanted to take a list of ints and double each one (ignoring for the purpose of the example that I could just use map), but I also wanted to count up how many times the number '5' appears in the list.
So to do the doubling I could do this:
foo [] = []
foo (x:xs) = x * 2 : foo xs
So far so easy. But how can I also maintain a count of how many times x is a five? The best solution I've got is to use an explicit accumulator like this, which I don't like as it reverses the list, so you need to do a reverse at the end:
foo total acc [] = (total, reverse acc)
foo total acc (x:xs) = foo (if x == 5 then total + 1 else total) (x*2 : acc) xs
But I feel like this should be able to be handled nicer by the State monad, which I haven't used before, but when I try to construct a function that will fit the pattern I've seen I get stuck because of the recursive call to foo. Is there a nicer way to do this?
EDIT: I need this to work for very long lists, so any recursive calls need to be tail-recursive too. (The example I have here manages to be tail-recursive thanks to Haskell's 'tail recursion modulo cons').
Using State monad it can be something like:
foo :: [Int] -> State Int [Int]
foo [] = return []
foo (x:xs) = do
i <- get
put $ if x==5 then (i+1) else i
r <- foo xs
return $ (x*2):r
main = do
let (lst,count) = runState (foo [1,2,5,6,5,5]) 0 in
putStr $ show count
This is a simple fold
foo :: [Integer] -> ([Integer], Int)
foo [] = ([], 0)
foo (x : xs) = let (rs, n) = foo xs
in (2 * x : rs, if x == 5 then n + 1 else n)
or expressed using foldr
foo' :: [Integer] -> ([Integer], Int)
foo' = foldr f ([], 0)
where
f x (rs, n) = (2 * x : rs, if x == 5 then n + 1 else n)
The accumulated value is a pair of both the operations.
Notes:
Have a look at Beautiful folding. It shows a nice way how to make such computations composable.
You can use State for the same thing as well, by viewing each element as a stateful computation. This is a bit overkill, but certainly possible. In fact, any fold can be expressed as a sequence of State computations:
import Control.Monad
import Control.Monad.State
-- I used a slightly non-standard signature for a left fold
-- for simplicity.
foldl' :: (b -> a -> a) -> a -> [b] -> a
foldl' f z xs = execState (mapM_ (modify . f) xs) z
Function mapM_ first maps each element of xs to a stateful computation by modify . f :: b -> State a (). Then it combines a list of such computations into one of type State a () (it discards the results of the monadic computations, just keeps the effects). Finally we run this stateful computation on z.

Inverting a fold

Suppose for a minute that we think the following is a good idea:
data Fold x y = Fold {start :: y, step :: x -> y -> y}
fold :: Fold x y -> [x] -> y
Under this scheme, functions such as length or sum can be implemented by calling fold with the appropriate Fold object as argument.
Now, suppose you want to do clever optimisation tricks. In particular, suppose you want to write
unFold :: ([x] -> y) -> Fold x y
It should be relatively easy to rule a RULES pragma such that fold . unFold = id. But the interesting question is... can we actually implement unFold?
Obviously you can use RULES to apply arbitrary code transformations, whether or not they preserve the original meaning of the code. But can you really write an unFold implementation which actually does what its type signature suggests?
No, it's not possible. Proof: let
f :: [()] -> Bool
f[] = False
f[()] = False
f _ = True
First we must, for f' = unFold f, have start f' = False, because when folding over the empty list we directly get the start value. Then we must require step f' () False = False to achieve fold f' [()] = False. But when now evaluating fold f' [(),()], we would again only get a call step f' () False, which we had to define as False, leading to fold f' [(),()] ≡ False, whereas f[(),()] ≡ True. So there exists no unFold f that fulfills fold $ unFold f ≡ f.                                                                                                                                              □
You can, but you need to make a slight modification to Fold in order to pull it off.
All functions on lists can be expressed as a fold, but sometimes to accomplish this, extra bookkeeping is needed. Suppose we add an additional type parameter to your Fold type, which passes along this additional contextual information.
data Fold a c r = Fold { _start :: (c, r), _step :: a -> (c,r) -> (c,r) }
Now we can implement fold like so
fold :: Fold a c r -> [a] -> r
fold (Fold step start) = snd . foldr step start
Now what happens when we try to go the other way?
unFold :: ([a] -> r) -> Fold a c r
Where does the c come from? Functions are opaque values, so it's hard to know how to inspect a function and know which contextual information it relies on. So, let's cheat a little. We're going to have the "contextual information" be the entire list, so then when we get to the leftmost element, we can just apply the function to the original list, ignoring the prior cumulative results.
unFold :: ([a] -> r) -> Fold a [a] r
unFold f = Fold { _start = ([], f [])
, _step = \a (c, _r) -> let c' = a:c in (c', f c') }
Now, sadly, this does not necessarily compose with fold, because it requires that c must be [a]. Let's fix that by hiding c with existential quantification.
{-# LANGUAGE ExistentialQuantification #-}
data Fold a r = forall c. Fold
{ _start :: (c,r)
, _step :: a -> (c,r) -> (c,r) }
fold :: Fold a r -> [a] -> r
fold (Fold start step) = snd . foldr step start
unFold :: ([a] -> r) -> Fold a r
unFold f = Fold start step where
start = ([], f [])
step a (c, _r) = let c' = a:c in (c', f c')
Now, it should always be true that fold . unFold = id. And, given a relaxed notion of equality for the Fold data type, you could also say that unFold . fold = id. You can even provide a smart constructor that acts like the old Fold constructor:
makeFold :: r -> (a -> r -> r) -> Fold a r
makeFold start step = Fold start' step' where
start' = ((), start)
step' a ((), r) = ((), step a r)
tl;dr:
Conclusion 1: you can't
What you asked for originally isn't possible, at least not by any version of what you wanted I can come up with. (See below.)
If change your data type to allow me to store intermediate calculations, I think I'll be fine, but even then,
the function unFold would be rather inefficient, which seems to run counter to your clever optimisation tricks agenda!
Conclusion 2: I don't think it achieves what you want, even if you work around it by changing the types
Any optimisation of the list algorithm would be subject to the problem that you've calculated the step function using the original unoptimised function, and quite probably in a complicated way.
Since there's no equality on functions, optimising step to something efficient isn't possible. I think you need a human to do unFold, not a compiler.
Anyway, back to the original question:
Could fold . unFold = id ?
No. Suppose we have
isSingleton :: [a] -> Bool
isSingleton [x] = True
isSingleton _ = False
then if we had unFold :: ([x] -> y) -> Fold x y then if foldSingleton was the same as unFold isSingleton would need to have
foldSingleton = Fold {start = False , step = ???}
Where step takes an element of the list and updates the result.
Now isSingleton "a" == True, we need
step False = True
and because isSingleton "ab" == False, we need
step True = False
so step = not would do so far, but also isSingleton "abc" == False so we also need
step False = False
Since there are functions ([x] -> y) that cannot be represented by a value of type Fold x y, there cannot exist a function unFold :: ([x] -> y) -> Fold x y such that fold . unFold = id, because id is a total function.
Edit:
It turns out you're not convinced by this, because you only expected unFold to work on functions that had a representation as a fold, so maybe you meant unFold.fold = id.
Could unFold . fold = id ?
No.
Even if you just want unFold to work on functions ([x] -> y) that can be obtained using fold :: Fold x y -> ([x] -> y), I don't think it's possible. Let's address the question by assuming now we have defined
combine :: X -> Y -> Y
initial :: Y
folded :: [X] -> Y
folded = fold $ Fold initial combine
Recovering the value initial is trivial: initial = folded [].
Recovery of the original combine is not, because there's no way to go from a function that gives you some values of Y to one which combines arbitrary values of Y.
For an example, if we had X = Y = Int and I defined
combine x y | y < 0 = -10
| otherwise = y + 1
initial = 0
then since combine just adds one to y every time you use it on positive y, and the initial value is 0, folded is indistinguishable from length in terms of its output. Notice that since folded xs is never negative, it's also impossible to define a function unFold :: ([x] -> y) -> Fold x y that ever recovers our combine function. This boils down to the fact that fold is not injective; it carries different values of type Fold x y to the same value of type [x] -> y.
Thus I've proved two things: if unFold :: ([x] -> y) -> Fold x y then both fold.unFold /= id and now also unFold.fold /= id
I bet you're not convinced by this either, because you don't really care whether you got Fold 0 (\_ y -> y+1) or Fold 0 combine back from unFold folded, seeing as they have the same value when refolded! Let's narrow the goalposts one more time. Perhaps you want unFold to work whenever the function is obtainable via fold, and you're happy for it not to give you inconsistent answers as long as when you fold the result again, you get the same function. I can summarise that with this next question:
Could fold . unFold . fold = fold ?
i.e. Could you define unFold so that fold.unFold is the identity on the set of functions obtainable via fold?
I'm really convinced this isn't possible, because it's not a tractible problem to calculate the step function without retaining extra information about intermediate values on sublists.
Suppose we had
unFold f = Fold {start = f [], step = recoverstep f}
we need
recoverstep f x1 initial == f [x1]
so if there's an Eq instance for x (ring the alarm bells!), then recoverstep must have the same effect as
recoverstep f x1 y | y == initial = f [x1]
also we need
recoverstep f x2 (f [x1]) == f [x1,x2]
so if there's an Eq instance for x, then recoverstep must have the same effect as
recoverstep f x2 y | y == (f [x1]) = f [x1,x2]
but there's a massive problem here: the variable x1 is free in the right hand side of this equation.
This means that logically, we can't tell what value the step function should have on an x unless we already
know what values it has been used on. We would need to store the values of f [x1], f [x1,x2] etc in the Fold
data type to make it work, and this is the clincher as to why we can't define unFold. If you change the data type Fold
to allow us to store information about intermediate lists, I can see it would work, but as it stands it's impossible
to recover the context.
Similar to Dan's answer, but using a slightly different approach. Instead of pairing the accumulator with partial results which will be thrown away at the end, we add a "post-processing" function which will convert from the accumulator type to the final result.
The same "cheat" for unFold just does all the work in the post-processing step:
{-# LANGUAGE ExistentialQuantification #-}
data Fold a r = forall c. Fold
{ _start :: c
, _step :: a -> c -> c
, _result :: c -> r }
fold :: Fold a r -> [a] -> r
fold (Fold start step result) = result . foldr step start
unFold :: ([a] -> r) -> Fold a r
unFold f = Fold [] (:) f
makeFold :: r -> (a -> r -> r) -> Fold a r
makeFold start step = Fold start step id

How can I iterate over a string without recursion?

isTogether' :: String -> Bool
isTogether' (x:xs) = isTogether (head xs) (head (tail xs))
For the above code, I want to go through every character in the string. I am not allowed to use recursion.
isTogether' (x:xs) = isTogether (head xs) (head (tail xs))
If I've got it right, you are interested in getting consequential char pairs from some string. So, for example, for abcd you need to test (a,b), (b,c), (c,d) with some (Char,Char) -> Bool or Char -> Char -> Bool function.
Zip could be helpful here:
> let x = "abcd"
> let pairs = zip x (tail x)
it :: [(Char, Char)]
And for some f :: Char -> Char -> Bool function we can get uncurry f :: (Char, Char) -> Bool.
And then it's easy to get [Bool] value of results with map (uncurry f) pairs :: [Bool].
In Haskell, a String is just a list of characters ([Char]). Thus, all of the normal higher-order list functions like map work on strings. So you can use whichever higher-order function is most applicable to your problem.
Note that these functions themselves are defined recursively; in fact, there is no way to go through the entire list in Haskell without either recursing explicitly or using a function that directly or indirectly recurses.
To do this without recursion, you will need to use a higher order function or a list comprehension. I don't understand what you're trying to accomplish so I can only give generic advice. You probably will want one of these:
map :: (a -> b) -> [a] -> [b]
Map converts a list of one type into another. Using map lets you perform the same action on every element of the list, given a function that operates on the kinds of things you have in the list.
filter :: (a -> Bool) -> [a] -> [a]
Filter takes a list and a predicate, and gives you a new list with only the elements that satisfy the predicate. Just with these two tools, you can do some pretty interesting things:
import Data.Char
map toUpper (filter isLower "A quick test") -- => "QUICKTEST"
Then you have folds of various sorts. A fold is really a generic higher order function for doing recursion on some type, so using it takes a bit of getting used to, but you can accomplish pretty much any recursive function on a list with a fold instead. The basic type of foldr looks like this:
foldr :: (a -> b -> b) -> b -> [a] -> b
It takes three arguments: an inductive step, a base case and a value you want to fold. Or, in less mathematical terms, you could think of it as taking an initial state, a function to take the next item and the previous state to produce the next state, and the list of values. It then returns the final state it arrived at. You can do some pretty surprising things with fold, but let's say you want to detect if a list has a run of two or more of the same item. This would be hard to express with map and filter (impossible?), but it's easy with recursion:
hasTwins :: (Eq a) => [a] -> Bool
hasTwins (x:y:xs) | x == y = True
hasTwins (x:y:xs) | otherwise = hasTwins (y:xs)
hasTwins _ = False
Well, you can express this with a fold like so:
hasTwins :: (Eq a) => [a] -> Bool
hasTwins (x:xs) = snd $ foldr step (x, False) xs
where
step x (prev, seenTwins) = (x, prev == x || seenTwins)
So my "state" in this fold is the previous value and whether we've already seen a pair of identical values. The function has no explicit recursion, but my step function passes the current x value along to the next invocation through the state as the previous value. But you don't have to be happy with the last state you have; this function takes the second value out of the state and returns that as the overall return value—which is the boolean whether or not we've seen two identical values next to each other.

Compute Most Frequent Occurance of Numbers of A Sorted List in Haskell

The question is to compute the mode (the value that occurs most frequently) of a sorted list of integers.
[1,1,1,1,2,2,3,3] -> 1
[2,2,3,3,3,3,4,4,8,8,8,8] -> 3 or 8
[3,3,3,3,4,4,5,5,6,6] -> 3
Just use the Prelude library.
Are the functions filter, map, foldr in Prelude library?
Starting from the beginning.
You want to make a pass through a sequence and get the maximum frequency of an integer.
This sounds like a job for fold, as fold goes through a sequence aggregating a value along the way before giving you a final result.
foldl :: (a -> b -> a) -> a -> [b] -> a
The type of foldl is shown above. We can fill in some of that already (I find that helps me work out what types I need)
foldl :: (a -> Int -> a) -> a -> [Int] -> a
We need to fold something through that to get the value. We have to keep track of the current run and the current count
data BestRun = BestRun {
currentNum :: Int,
occurrences :: Int,
bestNum :: Int,
bestOccurrences :: Int
}
So now we can fill in a bit more:
foldl :: (BestRun -> Int -> BestRun) -> BestRun -> [Int] -> BestRun
So we want a function that does the aggregation
f :: BestRun -> Int -> BestRun
f (BestRun current occ best bestOcc) x
| x == current = (BestRun current (occ + 1) best bestOcc) -- continuing current sequence
| occ > bestOcc = (BestRun x 1 current occ) -- a new best sequence
| otherwise = (BestRun x 1 best bestOcc) -- new sequence
So now we can write the function using foldl as
bestRun :: [Int] -> Int
bestRun xs = bestNum (foldl f (BestRun 0 0 0 0) xs)
Are the functions filter, map, foldr in Prelude library?
Stop...Hoogle time!
Did you know Hoogle tells you which module a function is from? Hoolging map results in this information on the search page:
map :: (a -> b) -> [a] -> [b]
base Prelude, base Data.List
This means map is defined both in Prelude and in Data.List. You can hoogle the other functions and likewise see that they are indeed in Prelude.
You can also look at Haskell 2010 > Standard Prelude or the Prelude hackage docs.
So we are allowed to map, filter, and foldr, as well as anything else in Prelude. That's good. Let's start with Landei's idea, to turn the list into a list of lists.
groupSorted :: [a] -> [[a]]
groupSorted = undefined
-- groupSorted [1,1,2,2,3,3] ==> [[1,1],[2,2],[3,3]]
How are we supposed to implement groupSorted? Well, I dunno. Let's think about that later. Pretend that we've implemented it. How would we use it to get the correct solution? I'm assuming it is OK to choose just one correct solution, in the event that there is more than one (as in your second example).
mode :: [a] -> a
mode xs = doSomething (groupSorted xs)
where doSomething :: [[a]] -> a
doSomething = undefined
-- doSomething [[1],[2],[3,3]] ==> 3
-- mode [1,2,3,3] ==> 3
We need to do something after we use groupSorted on the list. But what? Well...we should find the longest list in the list of lists. Right? That would tell us which element appears the most in the original list. Then, once we find the longest sublist, we want to return the element inside it.
chooseLongest :: [[a]] -> a
chooseLongest xs = head $ chooseBy (\ys -> length ys) xs
where chooseBy :: ([a] -> b) -> [[a]] -> a
chooseBy f zs = undefined
-- chooseBy length [[1],[2],[3,3]] ==> [3,3]
-- chooseLongest [[1],[2],[3,3]] ==> 3
chooseLongest is the doSomething from before. The idea is that we want to choose the best list in the list of lists xs, and then take one of its elements (its head does just fine). I defined this by creating a more general function, chooseBy, which uses a function (in this case, we use the length function) to determine which choice is best.
Now we're at the "hard" part. Folds. chooseBy and groupSorted are both folds. I'll step you through groupSorted, and leave chooseBy up to you.
How to write your own folds
We know groupSorted is a fold, because it consumes the entire list, and produces something entirely new.
groupSorted :: [Int] -> [[Int]]
groupSorted xs = foldr step start xs
where step :: Int -> [[Int]] -> [[Int]]
step = undefined
start :: [[Int]]
start = undefined
We need to choose an initial value, start, and a stepping function step. We know their types because the type of foldr is (a -> b -> b) -> b -> [a] -> b, and in this case, a is Int (because xs is [Int], which lines up with [a]), and the b we want to end up with is [[Int]].
Now remember, the stepping function will inspect the elements of the list, one by one, and use step to fuse them into an accumulator. I will call the currently inspected element v, and the accumulator acc.
step v acc = undefined
Remember, in theory, foldr works its way from right to left. So suppose we have the list [1,2,3,3]. Let's step through the algorithm, starting with the rightmost 3 and working our way left.
step 3 start = [[3]]
Whatever start is, when we combine it with 3 it should end up as [[3]]. We know this because if the original input list to groupSorted were simply [3], then we would want [[3]] as a result. However, it isn't just [3]. Let's pretend now that it's just [3,3]. [[3]] is the new accumulator, and the result we would want is [[3,3]].
step 3 [[3]] = [[3,3]]
What should we do with these inputs? Well, we should tack the 3 onto that inner list. But what about the next step?
step 2 [[3,3]] = [[2],[3,3]]
In this case, we should create a new list with 2 in it.
step 1 [[2],[3,3]] = [[1],[2],[3,3]]
Just like last time, in this case we should create a new list with 1 inside of it.
At this point we have traversed the entire input list, and have our final result. So how do we define step? There appear to be two cases, depending on a comparison between v and acc.
step v acc#((x:xs):xss) | v == x = (v:x:xs) : xss
| otherwise = [v] : acc
In one case, v is the same as the head of the first sublist in acc. In that case we prepend v to that same sublist. But if such is not the case, then we put v in its own list and prepend that to acc. So what should start be? Well, it needs special treatment; let's just use [] and add a special pattern match for it.
step elem [] = [[elem]]
start = []
And there you have it. All you have to do to write your on fold is determine what start and step are, and you're done. With some cleanup and eta reduction:
groupSorted = foldr step []
where step v [] = [[v]]
step v acc#((x:xs):xss)
| v == x = (v:x:xs) : xss
| otherwise = [v] : acc
This may not be the most efficient solution, but it works, and if you later need to optimize, you at least have an idea of how this function works.
I don't want to spoil all the fun, but a group function would be helpful. Unfortunately it is defined in Data.List, so you need to write your own. One possible way would be:
-- corrected version, see comments
grp [] = []
grp (x:xs) = let a = takeWhile (==x) xs
b = dropWhile (==x) xs
in (x : a) : grp b
E.g. grp [1,1,2,2,3,3,3] gives [[1,1],[2,2],[3,3,3]]. I think from there you can find the solution yourself.
I'd try the following:
mostFrequent = snd . foldl1 max . map mark . group
where
mark (a:as) = (1 + length as, a)
mark [] = error "cannot happen" -- because made by group
Note that it works for any finite list that contains orderable elements, not just integers.

Resources