Finding n such that f n is maximized in Haskell - haskell

I am using Project Euler problems to learn Haskell and I find a recurring theme in many of these problems where I need to find a value n that gives some property (usually minimum or maximum) to a function f n. As I build up a solution, I often find it convenient to create a list of pairs (n, f n). This helps me quickly see if I have any errors in my logic because I can check against the examples given in the problem statement. Then I "filter" out the single pair that gives the solution. My solution to problem 47 is an example:
-- Problem 47
import Data.List
import ProjectEuler
main = do
print (fst (head (filter (\(n, ds) -> (all (==consecutiveCount) ds))
(zip ns (map (map length)
(map (map primeDivisors) consecutives))))))
where consecutiveCount = 4
consecutive n start = take n [start..]
consecutives = map (consecutive consecutiveCount) ns
ns = [1..]
It seems to me that there's a more "haskelly" way to do this. Is there?

Use maximumBy from Data.List with comparing from Data.Ord, e.g.
maximumBy (comparing snd) [(n, f n) | n <- ns]
this will compute f once for each n. If f is cheap to compute, you can go with the simpler
maximumBy (comparing f) ns

Well, you could write your function as
main = print $ fst $ head
[ (x,ds) | x <- [1..]
, let ds=map primeDivisors [x..x+3], all ((==4).length) ds]
You could consider it "more Haskelly" to use Control.Arrow's (&&&), or "fan-out"
filter (all ((==4).length).snd)
. map (id &&& (\x-> map primeDivisors [x..x+3])) $ [1..]
To be able to tweak the code to try the simple examples first, you'd usually make it a function, abstracting over the variable(s) of interest, like so:
test n m = [ x | x <- [1..], all (==n) $ map (length.primeDivisors) [x..x+m-1]]
to search for m consequitive numbers each having n distinct prime factors. There is actually no need to carry the factorizations along in the final code.

Related

generate binary one bit change between all members

ı have a question. ı want to generate binary list .but between members of the list will be only one bit change.
oneBitAll :: Integral a => a -> [[String]]
for n=2
Output:
["00","01","11","10"] ve ["00","10","11","01"]
n=3
oneBitAll 3
[["000","001","011","010","110","111","101","100"], ["000","001","011","111","101","100","110","010"], ["000","001","101","100","110","111","011","010"], ["000","001","101","111","011","010","110","100"], ["000","010","011","001","101","111","110","100"], .....]
only one bit change between members.
please help.
this gives only one
g 0 = [""]
g n = (map ('0':)) (g (n-1)) ++ (map ('1':)) (reverse (g (n-1)))
gray code is true for this.but ı want to find all combinations.
how can I generate all possible gray codes for given n number?
permute [] = [[]]
permute xs = concatMap (\x -> map (x:) $ permute $ delete x xs) xs
g 0 = [""]
g n = (map ('0':)) (g (n-1)) ++ (map ('1':)) (reverse (g (n-1)))
oneBitAll n = (map transpose . permute . transpose $ g n)
This code generate half of possibilities.What can ı add this code?this code generates;
[["000","001","011","010","110","111","101","100"],["000","010","011","001","101","111","110","100"],["000","001","101","100","110","111","011","010"],["000","010","110","100","101","111","011","001"],["000","100","101","001","011","111","110","010"],["000","100","110","010","011","111","101","001"]]
but must generate 12 members.
There is probably a smarter way to do this that exploits more of the structure of gray codes. This way is sort of quick and dirty, but it seems to work fairly well.
The basic idea is we'll generate all sequences of bitstrings, then filter out the ones that aren't gray codes. We'll be slightly more clever, though, in that we'll check prefixes of each sequence to make sure they could plausibly be extended to a gray code, and prune prefixes that can't be.
For our purposes, a gray code will have five properties:
Each pair of consecutive bitstrings differs in exactly one place.
The sequence is cyclic: the first and last bitstring also differ in exactly one place.
No two bitstrings in a sequence are equal.
A code with bitstring length n has 2^n elements.
To break the cyclic symmetry, every code will start with the all-zero bitstring.
Three of these properties can be expressed on code prefixes:
import Control.Monad
import Data.List
validCodePrefix xss = nearbyPairs && unique && endsWithZeros where
nearbyPairs = all (uncurry nearby) (zip xss (tail xss))
unique = all ((1==) . length) . group . sort $ xss
endsWithZeros = all (all (=='0')) (take 1 (reverse xss))
nearby xs xs' = length [() | (x, x') <- zip xs xs', x /= x'] == 1
The cyclic condition applies only to completed codes, and can be written as:
cyclic xss = nearby (head xss) (last xss)
We can implement the search and enforce the length condition at the same time, by repeatedly choosing from all appropriate length bitstrings, and keeping only those ones that are valid:
codes n = go (2^n) [] where
go 0 code = [reverse code | cyclic code]
go i code = do
continuation <- replicateM n "01"
guard (validCodePrefix (continuation:code))
go (i-1) (continuation:code)

Generating all combinations of 6 Xs with 3 Qs in Haskell

I am trying to generate a list of all strings that consist of 6 Xs and 3 Qs.
A subset of the list I am trying to generate is as follows:
["XXXXXXQQQ", "XQXXQXXQX", "QXQXQXXXX",...
What is a good way to go about this?
Here is a dynamic programming solution using Data.Array. mem just stores memoized values.
import Data.Array
strings :: Int -> Int -> [String]
strings n m = strings' n m
where
mem :: Array (Int,Int) [String]
mem = array ((0,0),(n,m)) [ ((i,j), strings' i j) | i <- [0..n], j <- [0..m] ]
strings' 0 m = [replicate m 'X']
strings' n 0 = [replicate n 'Q']
strings' n m = (('Q':) <$> mem ! (n-1,m)) ++ (('X':) <$> mem ! (n,m-1))
The naive solution is to recursively choose one of X or Q until we run out of choices to make. This is especially convenient when using the list monad to model the nondeterministic choice, and leads to quite short code:
stringsNondet m 0 = [replicate m 'X']
stringsNondet 0 n = [replicate n 'Q']
stringsNondet m n = do
(char, m', n') <- [('X', m-1, n), ('Q', m, n-1)]
rest <- stringsNondet m' n'
return (char:rest)
The disadvantage of this approach is that it does a lot of extra work. If we choose an X and then choose a Q, the continuations are the same as if we had chosen a Q and then an X, but these continuations will be recomputed in the above. (And similarly for other choice paths that lead to shared continuations.)
Alec has posted a dynamic programming solution which solves this problem by introducing a recursively-defined array to share the subcomputations. I like this solution, but the recursive definition is a bit mind-bending. The following solution is also a dynamic programming solution -- subcomputations are also shared -- but uses no hand-written recursion. It does make use of standard recursive patterns (map, zip, iterate, ++, and !!) but notably does not require "tying the knot" as Alec's solution does.
As a warmup, let's discuss the type of the function of interest to us:
step :: [[String]] -> [[String]]
The final result of interest to us is [String], a collection of strings with a fixed number m of 'X's and a fixed number n of 'Q's. The step function will expect a collection of results, all of the same length, and will assume that the result at index m has m copies of 'X'. It will also produce a result with these properties, and where each result is one longer than the input results.
We implement step by producing two intermediate [[String]]s, one with an extra 'X' compared to the input results and one with an extra 'Q'. These two intermediates can then be zipped together with a little "stutter" to represent the slight difference in 'X' count between them. Thus:
step css = zipWith (++)
([[]] ++ map (map ('X':)) css)
(map (map ('Q':)) css ++ [[]])
The top-level function is now easy to write: we simply index into the iterated version of step by the length of the final string we want, then index into the list of results we get that way by the number of 'X's we want.
strings m n = iterate step [[[]]] !! (m+n) !! m
A bonus of this approach is the single, aesthetically pleasing base case of [[[]]].
Use permutations and nub functions from Data.List:
Prelude Data.List> nub $ permutations "XXXXXXQQQ"
["XXXXXXQQQ","QXXXXXXQQ","XQXXXXXQQ","XXQXXXXQQ","XXXQXXXQQ","XXXXQXXQQ","XXXXXQXQQ","QQXXXXXXQ","QXQXXXXXQ","QXXQXXXXQ","QXXXQXXXQ","QXXXXQXXQ","QXXXXXQXQ","XQQXXXXXQ","XQXQXXXXQ","XQXXQXXXQ","XQXXXQXXQ","XQXXXXQXQ","XXQQXXXXQ","XXQXQXXXQ","XXQXXQXXQ","XXQXXXQXQ","XXXQQXXXQ","XXXQXQXXQ","XXXQXXQXQ","XXXXQQXXQ","XXXXQXQXQ","XXXXXQQXQ","QQQXXXXXX","QQXQXXXXX","QQXXQXXXX","QQXXXQXXX","QQXXXXQXX","QQXXXXXQX","QXQQXXXXX","XQQQXXXXX","XQQXQXXXX","XQQXXQXXX","XQQXXXQXX","XQQXXXXQX","QXQXQXXXX","QXQXXQXXX","QXQXXXQXX","QXQXXXXQX","QXXQQXXXX","XQXQQXXXX","XXQQQXXXX","XXQQXQXXX","XXQQXXQXX","XXQQXXXQX","XQXQXQXXX","XQXQXXQXX","XQXQXXXQX","QXXQXQXXX","QXXQXXQXX","QXXQXXXQX","QXXXQQXXX","XQXXQQXXX","XXQXQQXXX","XXXQQQXXX","XXXQQXQXX","XXXQQXXQX","XXQXQXQXX","XXQXQXXQX","XQXXQXQXX","XQXXQXXQX","QXXXQXQXX","QXXXQXXQX","QXXXXQQXX","XQXXXQQXX","XXQXXQQXX","XXXQXQQXX","XXXXQQQXX","XXXXQQXQX","XXXQXQXQX","XQXXXQXQX","QXXXXQXQX","XXQXXQXQX","QXXXXXQQX","XQXXXXQQX","XXQXXXQQX","XXXQXXQQX","XXXXQXQQX","XXXXXQQQX"]
We can have a faster implementation as well:
insertAtEvery x [] = [[x]]
insertAtEvery x (y:ys) = (x:y:ys) : map (y:) (insertAtEvery x ys)
combinations [] = [[]]
combinations (x:xs) = nub . concatMap (insertAtEvery x) . combinations $ xs
Comparison with the previous solution in ghci:
Prelude Data.List> (sort . nub . permutations $ "XXXXXXQQQ") == (sort . combinations $ "XXXXXXQQQ")
True
Prelude Data.List> :set +s
Prelude Data.List> combinations "XXXXXXQQQ"
["XXXXXXQQQ","XXXXXQXQQ","XXXXXQQXQ","XXXXXQQQX","XXXXQXXQQ","XXXXQXQXQ","XXXXQXQQX","XXXXQQXXQ","XXXXQQXQX","XXXXQQQXX","XXXQXXXQQ","XXXQXXQXQ","XXXQXXQQX","XXXQXQXXQ","XXXQXQXQX","XXXQXQQXX","XXXQQXXXQ","XXXQQXXQX","XXXQQXQXX","XXXQQQXXX","XXQXXXXQQ","XXQXXXQXQ","XXQXXXQQX","XXQXXQXXQ","XXQXXQXQX","XXQXXQQXX","XXQXQXXXQ","XXQXQXXQX","XXQXQXQXX","XXQXQQXXX","XXQQXXXXQ","XXQQXXXQX","XXQQXXQXX","XXQQXQXXX","XXQQQXXXX","XQXXXXXQQ","XQXXXXQXQ","XQXXXXQQX","XQXXXQXXQ","XQXXXQXQX","XQXXXQQXX","XQXXQXXXQ","XQXXQXXQX","XQXXQXQXX","XQXXQQXXX","XQXQXXXXQ","XQXQXXXQX","XQXQXXQXX","XQXQXQXXX","XQXQQXXXX","XQQXXXXXQ","XQQXXXXQX","XQQXXXQXX","XQQXXQXXX","XQQXQXXXX","XQQQXXXXX","QXXXXXXQQ","QXXXXXQXQ","QXXXXXQQX","QXXXXQXXQ","QXXXXQXQX","QXXXXQQXX","QXXXQXXXQ","QXXXQXXQX","QXXXQXQXX","QXXXQQXXX","QXXQXXXXQ","QXXQXXXQX","QXXQXXQXX","QXXQXQXXX","QXXQQXXXX","QXQXXXXXQ","QXQXXXXQX","QXQXXXQXX","QXQXXQXXX","QXQXQXXXX","QXQQXXXXX","QQXXXXXXQ","QQXXXXXQX","QQXXXXQXX","QQXXXQXXX","QQXXQXXXX","QQXQXXXXX","QQQXXXXXX"]
(0.01 secs, 3,135,792 bytes)
Prelude Data.List> nub $ permutations "XXXXXXQQQ"
["XXXXXXQQQ","QXXXXXXQQ","XQXXXXXQQ","XXQXXXXQQ","XXXQXXXQQ","XXXXQXXQQ","XXXXXQXQQ","QQXXXXXXQ","QXQXXXXXQ","QXXQXXXXQ","QXXXQXXXQ","QXXXXQXXQ","QXXXXXQXQ","XQQXXXXXQ","XQXQXXXXQ","XQXXQXXXQ","XQXXXQXXQ","XQXXXXQXQ","XXQQXXXXQ","XXQXQXXXQ","XXQXXQXXQ","XXQXXXQXQ","XXXQQXXXQ","XXXQXQXXQ","XXXQXXQXQ","XXXXQQXXQ","XXXXQXQXQ","XXXXXQQXQ","QQQXXXXXX","QQXQXXXXX","QQXXQXXXX","QQXXXQXXX","QQXXXXQXX","QQXXXXXQX","QXQQXXXXX","XQQQXXXXX","XQQXQXXXX","XQQXXQXXX","XQQXXXQXX","XQQXXXXQX","QXQXQXXXX","QXQXXQXXX","QXQXXXQXX","QXQXXXXQX","QXXQQXXXX","XQXQQXXXX","XXQQQXXXX","XXQQXQXXX","XXQQXXQXX","XXQQXXXQX","XQXQXQXXX","XQXQXXQXX","XQXQXXXQX","QXXQXQXXX","QXXQXXQXX","QXXQXXXQX","QXXXQQXXX","XQXXQQXXX","XXQXQQXXX","XXXQQQXXX","XXXQQXQXX","XXXQQXXQX","XXQXQXQXX","XXQXQXXQX","XQXXQXQXX","XQXXQXXQX","QXXXQXQXX","QXXXQXXQX","QXXXXQQXX","XQXXXQQXX","XXQXXQQXX","XXXQXQQXX","XXXXQQQXX","XXXXQQXQX","XXXQXQXQX","XQXXXQXQX","QXXXXQXQX","XXQXXQXQX","QXXXXXQQX","XQXXXXQQX","XXQXXXQQX","XXXQXXQQX","XXXXQXQQX","XXXXXQQQX"]
(0.71 secs, 161,726,128 bytes)

Haskell : force evaluation/avoid garbage collecting when composing functions

I was looking for an elegant way to write this code :
import Data.List
import Data.Maybe
combi = [(x,y) | x <- [2..100], y <- [x..100]]
gsp = group (sort [x*y | (x,y) <- combi])
counts = zip (map head gsp) (map length gsp)
multipleProducts x = (fromJust (lookup x counts)) > 1
possibleComb1 = [(x,y) | (x,y) <- combi, multipleProducts (x*y)]
As I am reusing the same pattern multiple times but based on different input sets than [x*y | (x,y) <- combi], I came out with this code.
import Data.List
import Data.Maybe
combi = [(x,y) | x <- [2..100], y <- [x..100]]
onlyOneEl e x = (fromJust (lookup x counts)) == 1
where gs = group (sort e)
counts = zip (map head gs) (map length gs)
multipleProducts = not.(onlyOneEl [x*y | (x,y) <- combi])
possibleComb1 = [(x,y) | (x,y) <- combi, multipleProducts (x*y)]
However, Haskell seems to compute gs and count for every single time I call multipleProducts, taking a very big amount of time, instead of computing it only once, since the value of e is always the same with multipleProducts.
What is the most elegant way of avoiding the recalculation ?
Is there anything better than pre-calculating counts using one function and storing it in a local variable, and then passing it to onlyOneEl without the where ?
Because I'm later reusing onlyOneEl based on different sets, and I wanted to avoid having multiple counts variables.
I understood here why it did not evaluate it once per function, however, I do not use x as my last argument, and thus cannot do it exactly this way.
Thanks in advance !
You can rewrite it with little more goal oriented. Without getting into math, just with generation of data and filtering you can achieve the same with much less computation.
When you generate the product, add the multipliers to the tuple as well, i.e.
combi n = [((x,y),x*y) | x<-[2..n], y<-[x..n]]
now you can sort and group based on product
multi = filter ((>1) . length) . groupBy ((==) `on` snd) . sortBy (comparing snd) . combi
and extract the first element of the tuple, which will be the (x,y) pair to give same product more than once.
map (map fst) (multi 100)
if you don't care about the grouping, you can flatten the result, i.e.
concatMap (map fst) (multi 100)
The definition
onlyOneEl e x = fromJust (lookup x counts) == 1
where gs = group (sort e)
counts = zip (map head gs) (map length gs)
says "given e and x, set up the computations of gs and counts and use their (lazily calculated) results to calculate the expression fromJust (lookup x counts) == 1. You could write it completely equivalently as
onlyOneEl e x =
let gs = ...
counts = ...
in fromJust ...
On the other hand, if you move the x over to the other side with a lambda expression,
onlyOneEl e = \x -> fromJust ...
where ...
then you pull gs and counts into an outer scope. This code is equivalent to
onlyOneEl e =
let gs = ...
counts = ...
in \x -> fromJust ...
So gs and counts will only be calculated once per application of onlyOneEl to a single argument.
GHC supports a transformation called "full laziness" that does this kind of modification, which it applies when it thinks it will be a good idea. Apparently, GHC made the wrong judgement in this case.

Is `group list by size` a fold?

I came across this problem : grouping the elements of a list by packet of the same size, so that
> groupBy 3 [1..10]
[[1,2,3], [4,5,6], [7,8,9], [10]]
Nothing really hard to do, but first I was surprise that I couldn't find a function for it.
My first try was
groupBy _ [] = []
groupBy n xs = g : groupBy n gs
where (g, gs) = splitAt n xs
So far so good, it works, even on infinite list. However I don't like the first line groupBy _ [] = []. Seems a good candidate for a fold but I couldn't figure it out.
So can this function can be written as a fold or as a one liner ?
Update
My attempt at a one liner:
groupBy' n l = map (map snd) $ groupBy ((==) `on` fst) $ concatMap (replicate n) [1..] `zip` l
It took me 10 times more to write that the initial attempt.
Update 2
Following Ganesh answer and using unfoldr and the help of pointfree I came out with this convoluted point free solution
groupBy' n = unfoldr $ listToMaybe . (ap (>>) (return.splitAt n))
You can do it as a fold with some gymnastics, but it's much nicer as an unfold:
unfoldr (\xs -> if null xs then Nothing else Just (splitAt n xs))
[You'll need to import Data.List if you haven't already]
The type of unfoldr is:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
The idea of unfoldr is that a generating function decides whether to stop (Nothing) or keep going (Just). If the result is Just then the first element of the tuple is the next element of the output list, and the second element is passed to the generating function again.
As #leftroundabout pointed out in a comment on the question, an unfold is much more natural here because it treats the output list elements as similar to each other, whereas in a fold the input list elements should be treated similarly. In this case the need to start a new sublist every n elements of the input list makes this harder.

Haskell - Most frequent value

how can i get the most frequent value in a list example:
[1,3,4,5,6,6] -> output 6
[1,3,1,5] -> output 1
Im trying to get it by my own functions but i cant achieve it can you guys help me?
my code:
del x [] = []
del x (y:ys) = if x /= y
then y:del x y
else del x ys
obj x []= []
obj x (y:ys) = if x== y then y:obj x y else(obj x ys)
tam [] = 0
tam (x:y) = 1+tam y
fun (n1:[]) (n:[]) [] =n1
fun (n1:[]) (n:[]) (x:s) =if (tam(obj x (x:s)))>n then fun (x:[]) ((tam(obj x (x:s))):[]) (del x (x:s)) else(fun (n1:[]) (n:[]) (del x (x:s)))
rep (x:s) = fun (x:[]) ((tam(obj x (x:s))):[]) (del x (x:s))
Expanding on Satvik's last suggestion, you can use (&&&) :: (b -> c) -> (b -> c') -> (b -> (c, c')) from Control.Arrow (Note that I substituted a = (->) in that type signature for simplicity) to cleanly perform a decorate-sort-undecorate transform.
mostCommon list = fst . maximumBy (compare `on` snd) $ elemCount
where elemCount = map (head &&& length) . group . sort $ list
The head &&& length function has type [b] -> (b, Int). It converts a list into a tuple of its first element and its length, so when it is combined with group . sort you get a list of each distinct value in the list along with the number of times it occurred.
Also, you should think about what happens when you call mostCommon []. Clearly there is no sensible value, since there is no element at all. As it stands, all the solutions proposed (including mine) just fail on an empty list, which is not good Haskell. The normal thing to do would be to return a Maybe a, where Nothing indicates an error (in this case, an empty list) and Just a represents a "real" return value. e.g.
mostCommon :: Ord a => [a] -> Maybe a
mostCommon [] = Nothing
mostCommon list = Just ... -- your implementation here
This is much nicer, as partial functions (functions that are undefined for some input values) are horrible from a code-safety point of view. You can manipulate Maybe values using pattern matching (matching on Nothing and Just x) and the functions in Data.Maybe (preferable fromMaybe and maybe rather than fromJust).
In case you would like to get some ideas from code that does what you wish to achieve, here is an example:
import Data.List (nub, maximumBy)
import Data.Function (on)
mostCommonElem list = fst $ maximumBy (compare `on` snd) elemCounts where
elemCounts = nub [(element, count) | element <- list, let count = length (filter (==element) list)]
Here are few suggestions
del can be implemented using filter rather than writing your own recursion. In your definition there was a mistake, you needed to give ys and not y while deleting.
del x = filter (/=x)
obj is similar to del with different filter function. Similarly here in your definition you need to give ys and not y in obj.
obj x = filter (==x)
tam is just length function
-- tam = length
You don't need to keep a list for n1 and n. I have also made your code more readable, although I have not made any changes to your algorithm.
fun n1 n [] =n1
fun n1 n xs#(x:s) | length (obj x xs) > n = fun x (length $ obj x xs) (del x xs)
| otherwise = fun n1 n $ del x xs
rep xs#(x:s) = fun x (length $ obj x xs) (del x xs)
Another way, not very optimal but much more readable is
import Data.List
import Data.Ord
rep :: Ord a => [a] -> a
rep = head . head . sortBy (flip $ comparing length) . group . sort
I will try to explain in short what this code is doing. You need to find the most frequent element of the list so the first idea that should come to mind is to find frequency of all the elements. Now group is a function which combines adjacent similar elements.
> group [1,2,2,3,3,3,1,2,4]
[[1],[2,2],[3,3,3],[1],[2],[4]]
So I have used sort to bring elements which are same adjacent to each other
> sort [1,2,2,3,3,3,1,2,4]
[1,1,2,2,2,3,3,3,4]
> group . sort $ [1,2,2,3,3,3,1,2,4]
[[1,1],[2,2,2],[3,3,3],[4]]
Finding element with the maximum frequency just reduces to finding the sublist with largest number of elements. Here comes the function sortBy with which you can sort based on given comparing function. So basically I have sorted on length of the sublists (The flip is just to make the sorting descending rather than ascending).
> sortBy (flip $ comparing length) . group . sort $ [1,2,2,3,3,3,1,2,4]
[[2,2,2],[3,3,3],[1,1],[4]]
Now you can just take head two times to get the element with the largest frequency.
Let's assume you already have argmax function. You can write
your own or even better, you can reuse list-extras package. I strongly suggest you
to take a look at the package anyway.
Then, it's quite easy:
import Data.List.Extras.Argmax ( argmax )
-- >> mostFrequent [3,1,2,3,2,3]
-- 3
mostFrequent xs = argmax f xs
where f x = length $ filter (==x) xs

Resources