The 147 Problem from Programming Praxis

Programming Praxis is a great site. The 147 problem was recently posted there, and I tackled it with a bit too much time... Following is the code, with discussion.

(defun sum1/ (s)
    "Read the name as Sum the Inverses"
    (apply #'+ (mapcar #'/ s)))


(defun limits (n)
    "I took the limits discussion on the site a bit further..."
    (loop for i from n downto 1
          for prod = (apply #'* prods); Produces 1 to start with
          for prods = (cons (1+ prod) prods)
          for min = (min (car prods) n)
          for max = (max (* i prod) n)
        collect (list min max)))

When calling limits with n = 5, we get ((2 5) (3 8) (5 18) (5 84) (5 1806)) which shows the maximum ranges of each number we'll search for. The actual search for solutions to 1/a+1/b+1/c+1/d+1/e = 1 then looks like this:

(defun search1 (n &optional givens limits)
    "Actually finds all of the valid solutions to the 147
problem with n numbers. Call it without the optional arguments
to start it off."
    (let ((limits (if (null givens) (limits n) limits)))
        ;; Limits is whittled down during the recursion,
        ;; so detect starting off by looking at givens.
        (if (= n (length givens))
            (if (= 1 (sum1/ givens))
                (list (reverse givens)))
            (loop for next from (max (caar limits)
                                     (if givens (car givens) 0))
                           to (cadar limits)
                  for s = (cons next givens)
                until (or (every (lambda (i) (> i n)) s)
                          (and (not (cdr limits)) (< (sum1/ s) 1)))
                appending (search1 n s (cdr limits))))))



This code times how long it takes to solve the first few solutions before the times get too big:

(time (loop for n from 0 to 5 collect (nreverse (search1 n))))


Which gave 4.1 seconds on my computer.

Note that the code works for n = 0 and 1 (producing the empty list, and a single solution: 1, respectively). As some other people have mentioned, Common Lisp is well thought out. I think this also supports that thought, as I didn't design the algorithm specifically to handle cases n = 0 and 1.

And lastly, the following code finds the smallest distinct solutions, as described at Programming Praxis:

(sort
  (remove nil
    (mapcar (lambda (s)
              (if (apply #'/= s); Distinctness
                (cons s (apply #'+ s)))); Sum the denominators
            (search1 5)))
  #'< :key #'cdr); Sort by the sum of denominators

Which gives (3 4 5 6 20), confirming our solution.

Happy coding!