FizzBuzz cleanup - haskell

I'm still learning Haskell, and I was wondering if there is a less verbose way to express the below statement using 1 line of code:
map (\x -> (x, (if mod x 3 == 0 then "fizz" else "") ++
if mod x 5 == 0 then "buzz" else "")) [1..100]
Produces:
[(1,""),(2,""),(3,"fizz"),(4,""),(5,"buzz"),(6,"fizz"),(7,""),(8,""),(9,"fizz"),(10,"buzz"),(11,""),(12,"fizz"),(13,""),(14,""),(15,"fizzbuzz"),(16,""),(17,""),(18,"fizz"),(19,""),(20,"buzz"),(21,"fizz"),(22,""),(23,""),(24,"fizz"),(25,"buzz"),(26,""),(27,"fizz"),(28,""),(29,""),(30,"fizzbuzz"), etc
It just feels like I'm fighting the syntax more than I should. I've seen other questions for this in Haskell, but I'm looking for the most optimal way to express this in a single statement (trying to understand how to work the syntax better).

We need no stinkin' mod...
zip [1..100] $ zipWith (++) (cycle ["","","fizz"]) (cycle ["","","","","buzz"])
or slightly shorter
import Data.Function(on)
zip [1..100] $ (zipWith (++) `on` cycle) ["","","fizz"] ["","","","","buzz"]
Or the brute force way:
zip [1..100] $ cycle ["","","fizz","","buzz","fizz","","","fizz","buzz","","fizz","","","fizzbuzz"]

If you insist on a one-liner:
[(x, concat $ ["fizz" | mod x 3 == 0] ++ ["buzz" | mod x 5 == 0]) | x <- [1..100]]

How's about...
fizzBuzz = [(x, fizz x ++ buzz x) | x <- [1..100]]
where fizz n | n `mod` 3 == 0 = "fizz"
| otherwise = ""
buzz n | n `mod` 5 == 0 = "buzz"
| otherwise = ""

Couldn't resist going in the other direction and making it more complicated. Look, no mod...
merge as#(a#(ia,sa):as') bs#(b#(ib,sb):bs') =
case compare ia ib of
LT -> a : merge as' bs
GT -> b : merge as bs'
EQ -> (ia, sa++sb) : merge as' bs'
merge as bs = as ++ bs
zz (n,s) = [(i, s) | i <- [n,2*n..]]
fizzBuzz = foldr merge [] $ map zz [(1,""), (3,"fizz"), (5,"buzz")]

Along the same lines as larsmans' answer:
fizzBuzz = [(x, f 3 "fizz" x ++ f 5 "buzz" x) | x <- [1..100]]
where f k s n | n `mod` k == 0 = s
| otherwise = ""

I think the reason why you feel like you are fighting the syntax is because you are mixing too many types.
Instead of trying to print:
[(1, ""), (2,""), (3,"Fizz")...]
Just think of printing strings:
["1","2","Fizz"...]
My attempt:
Prelude> let fizzBuzz x | x `mod` 15 == 0 = "FizzBuzz" | x `mod` 5 == 0 = "Buzz" | x `mod` 3 == 0 = "Fizz" | otherwise = show x
Prelude> [fizzBuzz x | x <-[1..100]]
["1","2","Fizz","4","Buzz","Fizz","7","8","Fizz","Buzz","11","Fizz","13","14","FizzBuzz"...]
In order to convert an Int to String you use the:
show x

Just for studying
zipWith (\a b -> b a) (map show [1..100]) $ cycle [id,id,const "fizz",id,const "buzz",const "fizz",id,id,const "fizz",const "buzz",id,const "fizz",id,id,const "fizzbuzz"]
produces
["1","2","fizz","4","buzz","fizz","7","8","fizz","buzz","11","fizz","13","14","fizzbuzz","16","17","fizz","19","buzz","fizz","22","23","fizz","buzz","26","fizz","28","29","fizzbuzz","31","32","fizz","34","buzz","fizz","37","38","fizz","buzz","41","fizz","43","44","fizzbuzz","46","47","fizz","49","buzz","fizz","52","53","fizz","buzz","56","fizz","58","59","fizzbuzz","61","62","fizz","64","buzz","fizz","67","68","fizz","buzz","71","fizz","73","74","fizzbuzz","76","77","fizz","79","buzz","fizz","82","83","fizz","buzz","86","fizz","88","89","fizzbuzz","91","92","fizz","94","buzz","fizz","97","98","fizz","buzz"]

Writer monad may look nice (if you don't like concat):
fizzBuzz = [(x, execWriter $ when (x `mod` 3 == 0) (tell "fizz") >> when (x `mod` 5 == 0) (tell "buzz")) | x <- [1..100]]
It's not particularly succinct though.

Related

Getting parse error while doing list comprehensions in haskell

I'm writing a function like this:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (u == 2) && (v == 0) then 2 else v]
head t : t1
What the first let does is: return a list like this: [2,0,0,0,1,0], from the second let and the following line, I want the output to be like this: [2,2,2,2,1,0]. But, it's not working and giving parse error!!
What am I doing wrong?
There are two kinds of lets: the "let/in" kind, which can appear anywhere an expression can, and the "let with no in" kind, which must appear in a comprehension or do block. Since your function definition isn't in either, its let's must use an in, for example:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ] in
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y] in
return (head t : t1)
Alternately, since you can define multiple things in each let, you could consider:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y]
in return (head t : t1)
The code has other problems, but this should get you to the point where it parses, at least.
With an expression formed by a let-binding, you generally need
let bindings
in
expressions
(there are exceptions when monads are involved).
So, your code can be rewritten as follows (with simplification of r and w, which were not really necessary):
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ if y == 0 && x == 2 then 2 else y | (x,y) <- zip lst1 lst2]
t1 = [ if (v == 0) && (u == 2) then 2 else v | (u,v) <- zip t (tail t)]
in
head t : t1
(Note, I also switched u and v so that t1 and t has similar forms.
Now given a list like [2,0,0,0,1,0], it appears that your code is trying to replace 0 with 2 if the previous element is 2 (from the pattern of your code), so that eventually, the desired output is [2,2,2,2,1,0].
To achieve this, it is not enough to use two list comprehensions or any fixed number of comprehensions. You need to somehow apply this process recursively (again and again). So instead of only doing 2 steps, we can write out one step, (and apply it repeatedly). Taking your t1 = ... line, the one step function can be:
testing' lst =
let
t1 = [ if (u == 2) && (v == 0) then 2 else v | (u,v) <- zip lst (tail lst)]
in
head lst : t1
Now this gives:
*Main> testing' [2,0,0,0,1,0]
[2,2,0,0,1,0]
, as expected.
The rest of the job is to apply testing' as many times as necessary. Here applying it (length lst) times should suffice. So, we can first write a helper function to apply another function n times on a parameter, as follows:
apply_n 0 f x = x
apply_n n f x = f $ apply_n (n - 1) f x
This gives you what you expected:
*Main> apply_n (length [2,0,0,0,1,0]) testing' [2,0,0,0,1,0]
[2,2,2,2,1,0]
Of course, you can wrap the above in one function like:
testing'' lst = apply_n (length lst) testing' lst
and in the end:
*Main> testing'' [2,0,0,0,1,0]
[2,2,2,2,1,0]
NOTE: this is not the only way to do the filling, see the fill2 function in my answer to another question for an example of achieving the same thing using a finite state machine.

Haskell program that gives pretty prime numbers

I've made a haskell program that computes pretty prime numbers. Pretty primes are primes that are very close to a power of 2. You give 2 numbers for example: 10 and 20 then it returns 17 because 17 is the closest to a power of 2. 17 - 16 = 1 so it is the closest.
I've made this:
EDIT: I've rewrote the primefunction like this and e verw function but still getting -1.
-- Geeft priemgetallen terug tussen de 2 grenzen
-- English: Gives primenumbers between 2 numbers
priemgetallen :: Int->[Int]
priemgetallen b = take b (zeef [2..])
where zeef (p:xs) = p : zeef [x | x<-xs, (mod x p) /= 0]
-- Geeft machten terug tussen de 2 grenzen
-- English: Gives powers of 2 between 2 numbers
machten :: Int->Int->[Int]
machten a b
| a <= 2 = 2:[2^x| x<-[2..b], (2^x) `mod` 2 == 0, 2^x < b, 2^x > a]
| otherwise = [2^x| x<-[2..b], (2^x) `mod` 2 == 0, 2^x < b, 2^x > a]
-- English: the start of the function
prettyprime :: Int->Int->Int
prettyprime a b = vergelijk ( verw a (priemgetallen b)) (machten a b)
-- Filter the list
verw :: Int->[Int]->[Int]
verw _ [] = []
verw k (x:xs)
| x > k = [x] ++ verw k xs
| otherwise = verw k xs
-- Vergelijkt alle priemgetallen en geeft welke korste bij het ander ligt
-- English this function must see what primenumber is the closest to a power of 2 but I can't fix it
vergelijk :: [Int]->[Int]->Int
vergelijk [] _ = -1
vergelijk _ [] = -1
vergelijk (x:xs) (y:ys)
| x - y < vergelijk (x:xs) ys = x
| x - y > vergelijk (x:xs) ys = vergelijk xs (y:ys)
| x - y == vergelijk (x:xs) ys = x
main = do
print $ prettyprime 14 20
Can someone help me?
Kind regards,
The incomplete pattern is because you've omitted the case when x - y == vergelijk (x:xs) ys. The compiler is capable of warning you about this if you add -fwarn-incomplete-patterns and convert your guards into a real case:
vergelijk (x:xs) (y:ys) = case compare (x - y) (vergelijk (x:xs) ys) of
LT -> x
-- you will get a warning about having no case for EQ
GT -> vergelijk xs (y:ys)
As a bonus, this version is much less likely to recompute the recursive call, especially on low optimization levels.

fizzbuzz in haskell?

I'm trying to write 'fizzbuzz' in haskell using list comprehensions.
Why doesn't the following work, and how should it be?
[ if x `mod` 5 == 0 then "BUZZFIZZ"
if x `mod` 3 == 0 then "BUZZ"
if x `mod` 4 == 0 then "FIZZ" | x <- [1..20],
x `mod` 3 == 0,
x `mod` 4 == 0,
x `mod` 5 == 0 ]
This isn't valid Haskell. The else branch is not optional in if ... then ... else. Rather than using if, this seems like a good opportunity to use a case statement.
case (x `rem` 3, x `rem` 5) of
(0,0) -> "fizzbuzz"
(0,_) -> "fizz"
(_,0) -> "buzz"
_ -> show x
This snippet will work for a traditional "fizzbuzz"; your code seems to be slightly different.
First of all, you're missing the else parts of your if expressions. In Haskell, if is an expression, not a statement, so the else part is mandatory.
Secondly, the list comprehension only produces any values if all the guard expressions evaluate to True. There is no number between 1 and 20 that is 0 modulo 3, 4, and 5, so you'll get no results. You'll want to use || (logical OR) to combine them instead.
Third, most definitions of FizzBuzz want you to return the number itself if it does not meet any of the other conditions. In that case, you'll want to use show to convert the number to a String.
Here's another version that can be extended to an arbitrary number of substitutions:
fizzbuzz' :: [(Integer, String)] -> Integer -> String
fizzbuzz' ss n = foldl (\str (num, subst) -> if n `mod` num == 0 then str ++ subst else str ++ "") "" ss
fizzbuzz :: [(Integer, String)] -> Integer -> String
fizzbuzz ss n = if null str then show n else str
where str = fizzbuzz' ss n
You could inline fizzbuzz' in the where clause of fizzbuzz, but I found a separate function easier for testing.
You can run it like this:
λ> mapM_ putStrLn $ map (fizzbuzz [(3, "fizz"), (5, "buzz")]) [9..15]
fizz
buzz
11
fizz
13
14
fizzbuzz
Or with extra substitutions:
λ> mapM_ putStrLn $ map (fizzbuzz [(3, "fizz"), (5, "buzz"), (7, "dazz")]) [19..24]
19
buzz
fizzdazz
22
23
fizz
In general, it helps if you give the error as well, not just the code.
But in this case, the problem is that every if needs an else clause. Keep in mind that an if statement is just an expression, so both branches must return a value of an appropriate type.
You've got several bugs in the code, by the way, but that's the only compiler error.
Here is a response to the traditional FizzBuzz problem using list comprehension + guards.
fizzbuzz = [fb x| x <- [1..100]]
where fb y
| y `mod` 15 == 0 = "FizzBuzz"
| y `mod` 3 == 0 = "Fizz"
| y `mod` 5 == 0 = "Buzz"
| otherwise = show y
Or alternatively don't be afraid to move where clause into separate succinct function for evaluating x then call that function from your list comprehension. Its better to build on small concise functions than trying to solve it in one more complex function. e.g.
fizzval x
| x `mod` 15 == 0 = "FizzBuzz"
| x `mod` 3 == 0 = "Fizz"
| x `mod` 5 == 0 = "Buzz"
| otherwise = show x
fizzbuzz = [fizzval x| x <- [1..100]]
With the help of some judicious currying, Calvin Bottoms did it in 77 characters.
http://freshbrewedcode.com/calvinbottoms/2012/02/25/fizzbuzz-in-haskell/
[max(show x)(concat[n|(f,n)<-[(3,"Fizz"),(5,"Buzz")],mod x f==0])|x<-[1..25]]
The Monad Reader contains a solution as well as many valuable insights and some more fun exercises. The solution is copied here for those who just want to see it.
fizzbuzz :: Int -> String
fizzbuzz n = (test 3 "fizz" . test 5 "buzz") id (show n)
where test d s x | n `mod` d == 0 = const (s ++ x "")
| otherwise = x
There is no x that fullfills the condition to be divisible by 3, 4 and 5 in the range 1..20.
Therefore, you would get an empty list if the example were syntactically correct, which it is not.

Comparing 3 output lists in haskell

I am doing another Project Euler problem and I need to find when the result of these 3 lists is equal (we are given 40755 as the first time they are equal, I need to find the next:
hexag n = [ n*(2*n-1) | n <- [40755..]]
penta n = [ n*(3*n-1)/2 | n <- [40755..]]
trian n = [ n*(n+1)/2 | n <- [40755..]]
I tried adding in the other lists as predicates of the first list, but that didn't work:
hexag n = [ n*(2*n-1) | n <- [40755..], penta n == n, trian n == n]
I am stuck as to where to to go from here.
I tried graphing the function and even calculus but to no avail, so I must resort to a Haskell solution.
Your functions are weird. They get n and then ignore it?
You also have a confusion between function's inputs and outputs. The 40755th hexagonal number is 3321899295, not 40755.
If you really want a spoiler to the problem (but doesn't that miss the point?):
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch func low high
| low == high = low
| func mid = search low mid
| otherwise = search (mid + 1) high
where
search = binarySearch func
mid = (low+high) `div` 2
infiniteBinarySearch :: Integral a => (a -> Bool) -> a
infiniteBinarySearch func =
binarySearch func ((lim+1) `div` 2) lim
where
lim = head . filter func . lims $ 0
lims x = x:lims (2*x+1)
inIncreasingSerie :: (Ord a, Integral i) => (i -> a) -> a -> Bool
inIncreasingSerie func val =
val == func (infiniteBinarySearch ((>= val) . func))
figureNum :: Integer -> Integer -> Integer
figureNum shape index = (index*((shape-2)*index+4-shape)) `div` 2
main :: IO ()
main =
print . head . filter r $ map (figureNum 6) [144..]
where
r x = inIncreasingSerie (figureNum 5) x && inIncreasingSerie (figureNum 3) x
Here's a simple, direct answer to exactly the question you gave:
*Main> take 1 $ filter (\(x,y,z) -> (x == y) && (y == z)) $ zip3 [1,2,3] [4,2,6] [8,2,9]
[(2,2,2)]
Of course, yairchu's answer might be more useful in actually solving the Euler question :)
There's at least a couple ways you can do this.
You could look at the first item, and compare the rest of the items to it:
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [4,5,6] ]
False
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [1,2,3] ]
True
Or you could make an explicitly recursive function similar to the previous:
-- test.hs
f [] = True
f (x:xs) = f' x xs where
f' orig (y:ys) = if orig == y then f' orig ys else False
f' _ [] = True
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> f [ [1,2,3], [1,2,3], [1,2,3] ]
True
*Main> f [ [1,2,3], [1,2,3], [4,5,6] ]
False
You could also do a takeWhile and compare the length of the returned list, but that would be neither efficient nor typically Haskell.
Oops, just saw that didn't answer your question at all. Marking this as CW in case anyone stumbles upon your question via Google.
The easiest way is to respecify your problem slightly
Rather than deal with three lists (note the removal of the superfluous n argument):
hexag = [ n*(2*n-1) | n <- [40755..]]
penta = [ n*(3*n-1)/2 | n <- [40755..]]
trian = [ n*(n+1)/2 | n <- [40755..]]
You could, for instance generate one list:
matches :: [Int]
matches = matches' 40755
matches' :: Int -> [Int]
matches' n
| hex == pen && pen == tri = n : matches (n + 1)
| otherwise = matches (n + 1) where
hex = n*(2*n-1)
pen = n*(3*n-1)/2
tri = n*(n+1)/2
Now, you could then try to optimize this for performance by noticing recurrences. For instance when computing the next match at (n + 1):
(n+1)*(n+2)/2 - n*(n+1)/2 = n + 1
so you could just add (n + 1) to the previous tri to obtain the new tri value.
Similar algebraic simplifications can be applied to the other two functions, and you can carry all of them in accumulating parameters to the function matches'.
That said, there are more efficient ways to tackle this problem.

Detecting cyclic behaviour in Haskell

I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:
prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]
factorial n = product [1..n]
factC x = sum $ map factorial (decToList x)
chain74 x | x == 0 = []
| x == 1 = [1]
| x /= factC x = x : chain74 (factC x)
But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?
When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.
So this calculates the length of the non-cyclic part of a list:
uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
where uniqlength_ [] ls = length ls
uniqlength_ (x:xs) ls
| x `elem` ls = length ls
| otherwise = uniqlength_ xs (x:ls)
(Performance might be better when using a set instead of a list, but I haven't tried that.)
What about passing another argument (y for example) to the chain74 in the list comprehension.
Morning fail so EDIT:
[.. ((length $ chain74 x x False)-1)]
chain74 x y not_first | x == y && not_first = replace_with_stop_value_:-)
| x == 0 = []
| x == 1 = [1]
| x == 2 = [2]
| x /= factC x = x : chain74 (factC x) y True
I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:
http://coder.bsimmons.name/blog/2009/04/cycle-detection/
Just change the return type from String to Bool.
EDIT: Here is a modified version of the algorithm I posted about:
cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k [] = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
where find _ _ c _ [] = False
find i x c p (x':xs)
| c > k = False -- no cycles after k elements
| x == x' = True -- found a cycle
| c == p = find c x' (c+1) (p*2) xs
| otherwise = find i x (c+1) p xs
You can remove the 'k' if you know your list will either cycle or terminate soon.
EDIT2: You could change the following function to look something like:
prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]
Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:
chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])
Giving:
take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]
map head $ filter ((== 60) . length) (take 10000 chains)
is
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]
It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).
If you just want to remove cycles from a list you can use:
decycle :: Eq a => [a] -> [a]
decycle = dc []
where
dc _ [] = []
dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs
decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]

Resources