FizzBuzz Obsessions II: A short adventure in Functional FizzBuzzing

Having been properly warmed up with spreadsheets, let's now try some Haskell.

FizzBuzz in Haskell

I found it fairly straightforward using map and guards. Surely many other ways exist.

With two separate functions, explicit type annotations, and in a single file as a module

module Fizzbuzz where

fizzbuzz :: Int -> [String]
fizzbuzz x = fmap fizzy [1 .. x]

fizzy :: Int -> String
fizzy x
  | x `mod` 15 == 0 = "FizzBuzz"
  | x `mod`  3 == 0 = "Fizz"
  | x `mod`  5 == 0 = "Buzz"
  | otherwise       = show x

As one straight function without type annotations

fizzbuzz x = fmap fizzy [1 .. x]
  where fizzy n
          | n `mod` 15 == 0 = "FizzBuzz"
          | n `mod`  3 == 0 = "Fizz"
          | n `mod`  5 == 0 = "Buzz"
          | otherwise       = show n

Either one gives us:

λ> :load Fizzbuzz.hs
[1 of 1] Compiling Fizzbuzz  ( Fizzbuzz.hs, interpreted )
Ok, modules loaded: Fizzbuzz.
λ> fizzbuzz 16
["1","2","Fizz","4","Buzz","Fizz","7","8","Fizz","Buzz","11","Fizz","13","14","FizzBuzz","16"]

Quite elegant.

Notice that there's no for-loop here. It's not a procedure with beginning and end, but a mapping function over a subset of integers.

If this seems strange, notice that spreadsheets (essentially functional, but not quite high-level) have no for-loop either. The whole x→f(x) takes two columns and as many lines as wanted — and they are all there at once, timelessly.

Generalizing it

How would a generalized fizzbuzz look like in Haskell? And what about another auxiliary function for testing divisibility?

To avoid filling it with Maybe and Just to please the type system, in these exercises I simplified divisor testing, so it returns false instead of undefined when divided by 0. I'm also ignoring what would happen with negative numbers.

isDivisible :: Int -> Int -> Bool
(isDivisible) x d
  | d == 0         = False
  | x `mod` d == 0 = True
  | otherwise      = False

fizzbuzzGen :: Int -> Int -> Int -> [String]
fizzbuzzGen x d1 d2 = fmap (fizzyGen d1 d2) [1 .. x]

fizzyGen :: Int -> Int -> Int -> String
fizzyGen d1 d2 x
  | d1 == 0 || d2 == 0      = "N/A"
  | x `isDivisible` (d1*d2) = "FizzBuzz"
  | x `isDivisible`  d1     = "Fizz"
  | x `isDivisible`     d2  = "Buzz"
  | otherwise               = show x

It works:

λ> fizzbuzzGen 15 2 7
["1","Fizz","3","Fizz","5","Fizz","Buzz","Fizz","9","Fizz","11","Fizz","13","FizzBuzz","15"]
λ> fizzbuzzGen 15 0 3
["N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A"]
λ> fizzbuzzGen 15 0 0
["N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A","N/A"]

or we could simplify it into:

fizzbuzzGen x d1 d2 = fmap (fizzyGen d1 d2) [1 .. x]
  where fizzyGen d1 d2 x
          | x `mod` (d1*d2) == 0 = "FizzBuzz"
          | x `mod`  d1     == 0 = "Fizz"
          | x `mod`     d2  == 0 = "Buzz"
          | otherwise            = show x

with the only difference that a div/0 could happen:

λ> fizzbuzzGen 15 2 7
["1","Fizz","3","Fizz","5","Fizz","Buzz","Fizz","9","Fizz","11","Fizz","13","FizzBuzz","15"]
λ> fizzbuzzGen 15 7 2
["1","Buzz","3","Buzz","5","Buzz","Fizz","Buzz","9","Buzz","11","Buzz","13","FizzBuzz","15"]
λ> fizzbuzzGen 15 0 7
["*** Exception: divide by zero
λ>

Quite satisfactory. Let's try something else.

FizzBuzz in Emacs Lisp

Shared functions

We'll more explicitly assume that our FizzBuzz will deal only with non-negative integers.

Shared by all versions:

(defun divisiblep (nat d)
  "Test divisibility of natural number NAT by D."
  (and (natnump nat)
       (natnump d)
       (/= d 0)
       (zerop (% nat d))))

Shared by all versions except the second:

(defun fizzy (nat)
  "Given an natural number NAT, return its appropriate fizzbuzz."
  (when (natnump nat)
    (cond ((divisiblep nat 15) "FizzBuzz")
          ((divisiblep nat  3) "Fizz")
          ((divisiblep nat  5) "Buzz")
          (:otherwise           nat))))

The first version

(defun fizzbuzz1 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (when (natnump nat)
    (let ((fizzvec (make-vector nat nil))
          (i 0))
      (while (< i nat)
        (aset fizzvec i (fizzy (1+ i)))
        (setq i (1+ i)))
      fizzvec)))

Then:

(fizzbuzz1 20)

It works:

[1 2 "Fizz" 4 "Buzz" "Fizz" 7 8 "Fizz" "Buzz" 11 "Fizz" 13 14 "FizzBuzz" 16 17 "Fizz" 19 "Buzz"]

Let's try another.

A second version

Negligible for this size, for sure, but... can we make it slightly more efficient?

We can skip the nil-initialization of the vector and instead create and populate it from scratch with the number sequence. Then we only substitute where divisible. And we improve the conditional testings.

With fizzbuzz 10000000 and two big primes (instead of 3 and 5) it could make a difference.
Maybe. Or not.
Let's do it anyway.

(defun fizzbuzz2 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (when (natnump nat)
    (let* ((fizzvec (vconcat (number-sequence 1 nat)))
           (i 1))
      (while (<= i nat)
        (if (divisiblep i 3)
            (aset fizzvec (1- i) (if (divisiblep i 5)
                                     "FizzBuzz"
                                   "Fizz"))
          (when (divisiblep i 5)
            (aset fizzvec (1- i) "Buzz")))
        (setq i (1+ i)))
      fizzvec)))

And...

[1 2 "Fizz" 4 "Buzz" "Fizz" 7 8 "Fizz" "Buzz" 11 "Fizz" 13 14 "FizzBuzz" 16 17 "Fizz" 19 "Buzz"]

Good, it works. But... setq in a while loop? A bit too imperative, no?

So let's try yet another.

More functional versions

(defun fizzbuzz3 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (mapcar #'fizzy (number-sequence 1 nat)))

Ah! Cleaner, isn't it?

It works.

(1 2 "Fizz" 4 "Buzz" "Fizz" 7 8 "Fizz" "Buzz" 11 "Fizz" 13 14 "FizzBuzz" 16 17 "Fizz" 19 "Buzz")

We could have made it a bit shorter using dash:

(defun fizzbuzz4 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (-map #'fizzy (-iota nat 1)))

or, anaphorically:

(defun fizzbuzz5 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (--map (fizzy it) (-iota nat 1)))

Or the two standard alternatives to mapping

Using dolist:

(defun fizzbuzz6 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (let (res)
    (dolist (num (number-sequence 1 nat) (nreverse res))
      (push (fizzy num) res))))

Using cl-loop:

(defun fizzbuzz7 (nat)
  "Given a natural number NAT, return the fizzbuzz results from 1 to it."
  (cl-loop for num in (number-sequence 1 nat)
           collect (fizzy num)))

As the saying goes: "There's more than one way to fizz a buzz."

I could have stopped here. But didn't.

FizzBuzz in...?

"Hmmm... I wonder. How would FizzBuzz look like in that language that everyone loves to bash?"