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"