Problem 025: 1000-digit Fibonacci Number

From Project Euler:

The Fibonacci sequence is defined by the recurrence relation:

$Fn = F_{n−1} + F_{n−2}$, where $F_1 = 1$ and $F_2 = 1$.
Hence the first 12 terms will be:

$F_1 = 1$
$F_2 = 1$
$F_3 = 2$
$F_4 = 3$
$F_5 = 5$
$F_6 = 8$
$F_7 = 13$
$F_8 = 21$
$F_9 = 34$
$F_{10} = 55$
$F_{11} = 89$
$F_{12} = 144$

The 12th term, $F_{12}$, is the first term to contain three digits.

What is the index of the first term in the Fibonacci sequence to contain 1000 digits?

This problem can be solved analytically, and so runs in constant time. It all starts with Binet's formula, which states that the $n$th Fibonacci number $F_n$ has the expression:

$F_n = \frac{\phi^n - (-\phi)^{-n}}{2\phi - 1}$
where $\phi = \frac{1 + \sqrt{5}}{2}$

We're looking for the first one that has at least $d$ digits, so we want:

$\log_{10}(F_n) \ge d$
$\log_{10}\left( \frac{\phi^n - (-\phi)^{-n}}{2\phi - 1} \right) \ge d$

We want to get a closed-form expression for $n$ in terms of $d$, which is a challenge with this formula (if possible at all). Instead though if we realize that $(-\phi)^{-n}$ diminishes very quickly, we can do an optimization:

$\frac{\phi^n - (-\phi)^{-n}}{2\phi - 1} \approx \frac{\phi^n}{2\phi - 1}$ for larger $n$

This can give us a closed-form expression for $n$ in terms of $d$:

$n = \lceil \frac{d + \log(2\phi - 1)}{log(\phi)} \rceil$

Translating from math to Clojure:

(defn min-digits-fibonacci
  "Gets the first Fibonacci number with the specified number of digits."
  [num-digits]
  (let [phi (/ (+ 1.0 (Math/sqrt 5.0)) 2.0)]
    (int (Math/ceil (/ (+ (- num-digits 1)
                          (Math/log10 (- (* 2.0 phi) 1.0)))
                       (Math/log10 phi))))))

As expected, this runs very quickly:

$ lein run
Processing...
Index is: 4782
"Elapsed time: 2.180435 msecs"

Problem 024: Lexicographic Permutations

From Project Euler:

A permutation is an ordered arrangement of objects. For example, 3124 is one possible permutation of the digits 1, 2, 3 and 4. If all of the permutations are listed numerically or alphabetically, we call it lexicographic order. The lexicographic permutations of 0, 1 and 2 are:

012 021 102 120 201 210

What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?

This one can be done by brute force on a modern computer, but that would be way too slow. We can use a little deduction here to reduce the amount of computation we need. We know that there are 10! possible permutations of the digits 0 through 9, or 3 628 800 values. If we fix the first digit, we know that there are 9! or 362 880 numbers starting with that digit. Since the numbers are in numerical order, we konw that the first 362 880 start with 0, the next 362 880 start with 1, etc. Therefore the first permutation that starts with 1 is the 362 881st number, the first that starts with 2 is the 725 761st number (2 times 362 880, plus one), and the first that starts with 3 is the 1 008 641st number. Since this is greater than a million, we know that the first digit must be 2. Once we've found the first digit, we know that all the digits starting with 2 begin at position 725 761. If we subtract that from a million we get 274 239, which is the number of positions from the current one we want to get to. Here we can repeat the same logic as before: there are 8! (or 40 320) possible permutations starting with 20, and another 8! starting with 21, etc. Dividing 8! into 274 239 we get 6 plus some change. This does not mean that 6 is the next digit, but rather the 6th element of our remaining available digits is the next one. Since we've removed 2, the 6th element is 7. So we have 27 as the first two digits of the millionth permutation. We can now repeat the logic again: We subtract 6 times 8! from 274 239 to get 32 319. Fixing the first digit we have 7! (or 5040) remaining possible numbers, we do the quotient and get the index, and loop through. To write this out:

# use zero-based indexing:
999 999 = 2 * 9! + 274 239
# Available digits are (0 1 2 3 4 5 6 7 8 9), index 2 is 2
274 239 = 6 * 8! + 32 319
# Available digits are (0 1 3 4 5 6 7 8 9), index 6 is 7
 32 319 = 6 * 7! + 2079
# Available digits are (0 1 3 4 5 6 8 9), index 6 is 8
   2079 = 2 * 6! + 639
# Available digits are (0 1 3 4 5 6 9), index 2 is 3
...

Here's the code to do this:

(defn nth-lex-permutation
  "Gets the nth permutation from the set of digits up to max."
  [n max]
  (loop [available-numbers (range max)
         ; Keep track of the digits we've used so far as a number.
         digits-so-far 0
         ; Keep track of where we are within the current range of
         ; permutations.
         index-from-offset (- n 1)
         ; Track how many permutations there are when we fix one digit.
         num-permutations (factorial (- max 1))
         ; Track the factorial we're multiplying by.
         current-f (- max 1)]
    (if
     (empty? available-numbers) digits-so-far
     ; index-from-offset = idx * num-permutations + next-offset
     ; idx is the index of the next digit within available-numbers.
     (let [idx (quot index-from-offset num-permutations)
           value (nth available-numbers idx)
           remaining-numbers (remove #(= % value) available-numbers)
           next-digits (+ (* 10 digits-so-far) value)
           next-offset (rem index-from-offset num-permutations)
           next-num-permutations
           (if (zero? current-f)
             0
             (/ num-permutations current-f))]
       (recur remaining-numbers
              next-digits
              next-offset
              next-num-permutations
              (- current-f 1))))))

This runs very fast:

$ lein run
Processing...
Value is: 2783915460
"Elapsed time: 2.049982 msecs"

Problem 023: Non-abundant Sums

From Project Euler:

A perfect number is a number for which the sum of its proper divisors is exactly equal to the number. For example, the sum of the proper divisors of 28 would be $1 + 2 + 4 + 7 + 14 = 28$, which means that 28 is a perfect number.

A number n is called deficient if the sum of its proper divisors is less than n and it is called abundant if this sum exceeds n.

As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest number that can be written as the sum of two abundant numbers is 24. By mathematical analysis, it can be shown that all integers greater than 28123 can be written as the sum of two abundant numbers. However, this upper limit cannot be reduced any further by analysis even though it is known that the greatest number that cannot be expressed as the sum of two abundant numbers is less than this limit.

Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.

This one could potentially be done in a more efficient manner, but it runs reasonably quickly.
We'll first start off with a function that gets all the abundant numbers up to a certain maximum, using

sum-divisors

from our amicable numbers problem:

(defn abundant-numbers
  "Gets all abundant numbers below a maximum."
  [max]
  (set (->> (range 1 max)
            (filter #(< % (sum-divisors %))))))

From there, we'll use a predicate to determine if something is the sum of two abundant numbers:

(defn sum-of-elements?
  "Determines if a number is the sum of two elements in a set."
  [s n]
  (some #(contains? s (- n %)) s))

Combining these two functions, we can put it all together:

(defn not-sum-of-abundants
  [max]
  (let [abundants (abundant-numbers max)]
    (->> (range 1 max)
         (remove #(sum-of-elements? abundants %))
         (reduce +))))

This runs in a reasonable amount of time:

$ lein run
Processing...
Total is: 4179871
"Elapsed time: 4959.157526 msecs"

While 5 seconds isn't really ideal, it is fast enough for our purposes. I did try one alternative method, which was to first compute the abundant numbers, followed by the set of all sums of two abundant numbers, and then filtering one set on the other. This unfortunately took 30 seconds, so I stuck with this method here.

Problem 022: Names Scores

From Project Euler:

Using names.txt (right click and 'Save Link/Target As...'), a 46K text file containing over five-thousand first names, begin by sorting it into alphabetical order. Then working out the alphabetical value for each name, multiply this value by its alphabetical position in the list to obtain a name score.

For example, when the list is sorted into alphabetical order, COLIN, which is worth $3 + 15 + 12 + 9 + 14 = 53$, is the 938th name in the list. So, COLIN would obtain a score of $938 × 53 = 49714$.

What is the total of all the name scores in the file?

This one is very straight-forward. Parse the file, sort it, and calculate the scores.

We'll start off with a simple function that loads in a file, splitting on commas and stripping off quotes:

(defn load-names
  [filename]
  ; The data is stored as a comma-separated list of strings
  ; with double-quotes.
  (->> (clojure.string/split (slurp filename) #",")
       (map #(clojure.string/replace % #"\"" ""))))

We'll then define a function that calculates the score for a name. Since A is 1, B is 2, etc. we can just use the ASCII value of the character, and subtract 64 (as A is ASCII 65):

(defn calculate-score
  [name]
  (->> (upper-case name)
       (map int)
       (map #(- % 64))
       (reduce +)))

Now that we have everything, it's a simple pass over all the names in the list to get the scores:

(defn total-scores
  [filename]
  (->> (load-names filename)
       (sort)
       ; Get the score for the name
       (map calculate-score)
       ; Scale by the index of the name. Note that map-indexed
       ; is zero-based, so we need to add one.
       (map-indexed (fn [idx value] (* (+ 1 idx) value)))
       (reduce +)))

This runs very fast:

$ lein run
Processing...
Total scores: 871198282
"Elapsed time: 31.831402 msecs"

Problem 021: Amicable Numbers

It's been a long time since I've posted! That's alright though, we're back into it now. From Project Euler:

Let $d(n)$ be defined as the sum of proper divisors of $n$ (numbers less than $n$ which divide evenly into $n$).
If $d(a) = b$ and $d(b) = a$, where $a ≠ b$, then $a$ and $b$ are an amicable pair and each of $a$ and $b$ are called amicable numbers.

For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 and 110; therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4, 71 and 142; so $d(284) = 220$.

Evaluate the sum of all the amicable numbers under 10000.

$n!$ means $n × (n − 1) × ... × 3 × 2 × 1$

There's a lot of potential optimizations for this one, but I found it works just fine by brute forcing it. We'll start by defining a function that sums the divisors of a number:

(defn sum-divisors
  "Sums the divisors for the provided number."
  [n]
  (assert (> 0 n))
  ; Loop through all the numbers from 2 to sqrt(n). We only need to
  ; go to sqrt(n) because all divisors less than that will have a
  ; corresponding divisor greater than sqrt(n).
  (loop [current 2
         ; Start total from 1 because 1 is always a divisor.
         total 1]
    (if (> current (Math/sqrt n))
      total
      (recur (+ 1 current)
             (if (= 0 (mod n current))
               ; In the case of a square number, we only want to
               ; add the number once.
               (if (= current (quot n current))
                 (+ total current)
                 ; Here we're not square, so we add both the number
                 ; and it's complement on the other
                 ; side of sqrt(n).
                 (+ total current (quot n current)))
               total)))))

After that, our code is pretty straight-forward:

(defn sum-amicable-numbers
  "Sums all amicable numbers up to and including `max`."
  [max]
  (->> (range 1 (+ 1 max))
       (map #(list % (sum-divisors %)))
       ; Prune out numbers that are amicable with themselves.
       (remove #(= (first %) (last %)))
       ; Filter out any non-amicable numbers.
       (filter #(= (first %) (sum-divisors (last %))))
       ; And sum them all up.
       (map first)
       (reduce +)))

This runs very fast:

$ lein run
Processing...
Total is: 41274
"Elapsed time: 153.883368 msecs"

Problem 020: Factorial digit sum

From Project Euler:

$n!$ means $n × (n − 1) × ... × 3 × 2 × 1$

For example, $10! = 10 × 9 × ... × 3 × 2 × 1 = 3628800$,
and the sum of the digits in the number $10! is 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27$.

Find the sum of the digits in the number $100!$

This is pretty straight-forward, since Clojure supports arbitrary precision arithmetic. You just have to be a bit careful when writing factorial to ensure that it actually uses them instead of just overflowing:

(defn factorial [n]
  (reduce * (range 1N n)))

In Problem 008 we had to calculate the product of the digits of a number. Since here we're calculating the sum, I figured I'd create a function that reduces the digits of a number according to some function, and define a few specializations of it:

(defn reduce-digits [f n]
  "Reduce the digits of `n` using some function."
  (loop [current (quot n 10)
         total (mod n 10)]
    (if (== 0 current)
      total
      (recur (quot current 10)
             (f total (mod current 10))))))

(defn prod-digits [n]
  "Multiply the digits of `n` together."
  (reduce-digits * n))

(defn sum-digits [n]
  "Add the digits of `n` together."
  (reduce-digits + n))

After that, our code is pretty straight-forward:

(defn sum-factorial-digits [n]
  (sum-digits (factorial n)))

This runs very fast:

$ lein run
Processing...
648N
"Elapsed time: 5.780961 msecs"

Problem 019: Counting Sundays

From Project Euler:

You are given the following information, but you may prefer to do some research for yourself.

1 Jan 1900 was a Monday.
Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

Date math is never fun, so we'll just use a built-in library. We'll start off in January 1901 and count our way up through the months, adding to a tally if the first of the month is a Sunday:

(use '[java-time :only [local-date sunday?]])

(defn count-sundays []
  (loop [year 1901
         month 1
         total 0]
    (if (== year 2001)
      total
      (let [today (local-date year month)]
        (recur (+ year (if (== 11 month) 1 0))
               (if (== 12 month) 1 (+ month 1))
               (+ total (if (sunday? today) 1 0))))))

This runs pretty quick:

$ lein run
Processing...
171
"Elapsed time: 136.869657 msecs"

Problem 018: Maximum Path Sum I

From Project Euler:

By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.

3
7 4
2 4 6
8 5 9 3

That is, 3 + 7 + 4 + 9 = 23.

Find the maximum total from top to bottom of the triangle below:

75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

NOTE: As there are only 16384 routes, it is possible to solve this problem by trying every route. However, Problem 67, is the same challenge with a triangle containing one-hundred rows; it cannot be solved by brute force, and requires a clever method! ;o)

We could brute force this one or even solve it by hand, but since Problem 67 is much more complex we might as well solve this one now. An easy dynamic programming solution is just to start from the bottom and work our way up. Starting from the second-to-last row, for each index $i$ determine whether a left or a right is best by taking the max of the values in spots $i$ and $i + 1$ in the next row, and adding that to our current element.

The code is pretty straight-forward:

(defn collapse [row1 row2]
    (assert (== (+ 1 (count row1)) (count row2)))
    (->> (range (count row1))
         (map #(+ (nth row1 %)
                  (max (nth row2 %)
                       (nth row2 (+ % 1)))))))

(defn solve [rows]
  (assert (> (count rows) 0))
  (loop [current-row (- (count rows) 2)
         _rows rows]
    (if (== current-row -1)
      (first (first _rows))
      (recur (- current-row 1)
             (assoc _rows
                    current-row
                    (collapse (nth _rows current-row)
                              (nth _rows (+ current-row 1))))))))

And it runs really fast:

rob@alien ~/code/euler/clj-euler $ lein run
Processing...
1074
"Elapsed time: 4.771813 msecs"

Problem 017: Number letter counts

From Project Euler:

If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.

If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?

NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage.

This one doesn't really involve anything fancy, it's just a simple list of sometimes-recursive conditions:

(defn translate [n]
  (cond
    (== n 1000) "onethousand"
    (>= n 100) (str (translate (quot n 100))
                    "hundred"
                    (if (> (mod n 100) 0)
                      (str "and" (translate (mod n 100)))
                      ""))
    (< n 20) (nth ["zero" "one" "two" "three" "four" "five" "six" "seven"
                   "eight" "nine" "ten" "eleven" "twelve" "thirteen"
                   "fourteen" "fifteen" "sixteen" "seventeen" "eighteen"
                   "nineteen"]
                  n)
    (== 0 (mod n 10)) (nth ["twenty" "thirty" "forty" "fifty" "sixty"
                            "seventy" "eighty" "ninety"]
                           (- (quot n 10) 2))
    :else (str (translate (* (quot n 10) 10))
               (translate (mod n 10)))))

(defn count-letters [n]
  (->> (range 1 (+ 1 n))
       (map translate)
       (map count)
       (reduce +)))

As expected, it doesn't take long at all to run:

$ lein run
Processing...
21124
"Elapsed time: 14.712378 msecs"

Problem 016: Power digit sum

From Project Euler:

$2^{15} = 32768$ and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.

What is the sum of the digits of the number $2^{1000}$?

There is probably a fancy way to do this using the properties of powers and modulo. However since Clojure supports bigints, we can just brute force this one by setting a variable to $2^1000$ and then just summing the digits of it:

(use 'clojure.math.numeric-tower)

(defn calculate [power]
  (loop [n (expt 2 power)
         total 0]
    (if (== n 0)
      total
      (recur (quot n 10)
             (+ total (mod n 10))))))

This runs very fast:

$ lein run
Processing...
1366N
"Elapsed time: 5.569124 msecs"

Problem 015: Lattice paths

From Project Euler:

Starting in the top left corner of a 2×2 grid, and only being able to move to the right and down, there are exactly 6 routes to the bottom right corner.

How many such routes are there through a 20×20 grid?

There is a very fast solution for this problem using combinatorics. It's a very interesting approach, but since I didn't think of it and swiped it from somewhere else, I'll leave it as an exercise to you to figure that one out.

What I did was approach this as a dynamic programming problem. For each point in the lattice, the only ways to get there are from the left or from the top. An edge case (pun intended) is along the left and top edges, for every point there is only one possible way to get there. So for each point the number of paths $P(x, y)$ is:
$$
P(x, y) = \left\{
\begin{array}{ll}
1 & x = 0\ or\ y = 0 \\
P(x - 1, y) + P(x, y - 1) & otherwise
\end{array}
\right.
$$
At first glance this might look like a recursive solution, however that will be very inefficient since we'll end up calculating several values many times. Instead, we'll use a dynamic programming approach to build up a grid of values, starting from one edge and working our way across. Once we've filled the grid, we return the value in the bottom right corner.

(defn count-routes [width height]
  (loop [x 0
         y 0
         grid {}]
    (if (and (== x 0) (== y height))
      (grid [(- width 1) (- height 1)])
      (recur (mod (+ x 1) width)
             (if (== x (- width 1))
               (+ y 1)
               y)
             (assoc grid
                    [x y]
                    (+ (if (> x 0) (grid [(- x 1) y]) 1)
                       (if (> y 0) (grid [x (- y 1)]) 1)))))))

This runs super fast:

$ lein run
Processing...
137846528820
"Elapsed time: 7.410219 msecs"