I am having so much fun implementing some of the unimplemented tasks for common lisp at rosetta code. Today, I am going to look at the problem of writing Egyptian fractions.
Any rational number \(\frac{p}{q}\) can be written as a sum (not uniquely) as \[ \frac{p}{q} = \sum_i \frac{1}{n_i} \] There is a recursive algorithm that relies on the equation \[ \frac{p}{q} = \frac{1}{\lceil q/p\rceil} + \frac{-q \text{ mod } p}{q\lceil q/p\rceil} \]
(defun egyption-fractions (x y &optional acc)
(let ((a (/ x y)))
(cond
((> (numerator a) (denominator a))
(multiple-value-bind (q r) (floor x y)
(if (zerop r)
(cons q acc)
(egyption-fractions r y (cons q acc)))))
((= (numerator a) 1)
(reverse (cons a acc)))
(t (let ((b (ceiling y x)))
(egyption-fractions (mod (- y) x)
(* y b)
(cons (/ b) acc)))))))EGYPTION-FRACTIONSLet us test:
(egyption-fractions 43 48)
(egyption-fractions 5 121)
(egyption-fractions 2014 59)(1/2 1/3 1/16)
(1/25 1/757 1/763309 1/873960180913 1/1527612795642093418846225)
(34 1/8 1/95 1/14947 1/670223480)There are few other tasks were needed in the original question. For that we are going to need an auxillary function
(defun test (n fn)
(car (sort (loop for i from 1 to n append
(loop for j from 2 to n collect
(cons (/ i j) (funcall fn (egyption-fractions i j)))))
#'>
:key #'cdr)))TESTTo find the fraction that has the longest expansion for \(\frac{p}{q}\) with \(1\leq p\leq 99\) and \(1\leq q\leq 99\) we write
(test 99 #'length)(97/53 . 9)To find the fraction that has the largest denominator in its expansion for the same range we write
(test 99 (lambda (xs) (loop for x in xs maximizing (denominator x))))(8/97
. 579504587067542801713103191859918608251030291952195423583529357653899418686342360361798689053273749372615043661810228371898539583862011424993909789665)