I've been amusing myself with these little puzzles. They're simple enough you can do them in your head, but I coded them up just for fun and to see if they worked.
;;; -*- Lisp -*-
(defpackage "PUZZLE"
(:use)
(:import-from "COMMON-LISP"
"AND"
"COND"
"DEFUN"
"IF"
"FUNCALL"
"FUNCTION"
"LAMBDA"
"LET"
"MULTIPLE-VALUE-BIND"
"NIL"
"NOT"
"OR"
"T"
"VALUES"
"ZEROP"))
(defun puzzle::shr (n) (floor n 2))
(defun puzzle::shl0 (n) (* n 2))
(defun puzzle::shl1 (n) (1+ (* n 2)))
(in-package "PUZZLE")
;;; You can only use the symbols you can access in the PUZZLE package.
;;; Problem -1 (Example). Define =
(defun = (l r)
(cond ((zerop l) (zerop r))
((zerop r) nil)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (zerop l0)
(and (zerop r0)
(= l* r*))
(and (not (zerop r0))
(= l* r*))))))))
;;; Problem 0. Define >
;;; Problem 1. Define (inc n), returns n + 1 for any non-negative n.
;;; Problem 2. Define (dec n), returns n - 1 for any positive n.
;;; Problem 3. Define (add l r), returns the sum of l and r where l
;;; and r each are non-negative numbers.
;;; Problem 4. Define (sub l r), returns the difference of l and r
;;; where l and r are non-negative numbers and l >= r.
;;; Problem 5. Define (mul l r), returns the product of l and r where
;;; l and r are non-negative integers.
;;; Problem 6. Define (pow l r), returns l raised to the r power,
;;; where l is positive and r is non-negative.
;;; Problem 7. Define (div l r), returns the quotient and remainder
;;; of l/r. l is non-negative and r is positive.
;;; Problem 8. Define (log l r), returns the integer logarithm of l
;;; base r
My Solutions
;;; Problem 0. Define >
(defun > (l r)
(cond ((zerop l) nil)
((zerop r) t)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (and (not (zerop l0)) (zerop r0))
(not (> r* l*))
(> l* r*)))))))
This one turned out to be trickier than I thought. I figured you’d
basically discard the low order bit and just compare the high ones.
And you do, but for this one case where the left bit is one and the
right bit is zero. In this case, l > r if l* >= r*, so we
swap the arguments and invert the sense of the conditional.
;;; Problem 1. Define (inc n), returns n + 1 for any non-negative n.
(defun inc (n)
(multiple-value-bind (n* n0) (shr n)
(if (zerop n0)
(shl1 n*)
(shl0 (inc n*)))))
;;; Problem 2. Define (dec n), returns n - 1 for any positive n.
(defun dec (n)
(multiple-value-bind (n* n0) (shr n)
(if (zerop n0)
(shl1 (dec n*))
(shl0 n*))))
;;; Problem 3. Define (add l r), returns the sum of l and r where l
;;; and r each are non-negative numbers.
(defun add (l r)
(cond ((zerop l) r)
((zerop r) l)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (zerop l0)
(if (zerop r0)
(shl0 (add l* r*))
(shl1 (add l* r*)))
(if (zerop r0)
(shl1 (add l* r*))
(shl0 (addc l* r*)))))))))
(defun addc (l r)
(cond ((zerop l) (inc r))
((zerop r) (inc l))
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (zerop l0)
(if (zerop r0)
(shl1 (add l* r*))
(shl0 (addc l* r*)))
(if (zerop r0)
(shl0 (addc l* r*))
(shl1 (addc l* r*)))))))))
;;; Problem 4. Define (sub l r), returns the difference of l and r
;;; where l and r are non-negative numbers and l >= r.
(defun sub (l r)
(cond ((zerop l) 0)
((zerop r) l)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (zerop l0)
(if (zerop r0)
(shl0 (sub l* r*))
(shl1 (subb l* r*)))
(if (zerop r0)
(shl1 (sub l* r*))
(shl0 (sub l* r*)))))))))
(defun subb (l r)
(cond ((zerop l) 0)
((zerop r) (dec l))
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (zerop l0)
(if (zerop r0)
(shl1 (subb l* r*))
(shl0 (subb l* r*)))
(if (zerop r0)
(shl0 (sub l* r*))
(shl1 (subb l* r*)))))))))
The presence of a carry or borrow is encoded by which procedure you are in. Effectively, we're encoding the carry or borrow in the program counter.
;;; Problem 5. Define (mul l r), returns the product of l and r where
;;; l and r are non-negative integers.
(defun fma (l r a)
(if (zerop r)
a
(multiple-value-bind (r* r0) (shr r)
(fma (shl0 l) r* (if (zerop r0) a (add l a))))))
(defun mul (l r) (fma l r 0))
This has a nice iterative solution if we define a “fused multiply add” operation that given l, r, and a, computes (+ (* l r) a).
Exponentiation has an obvious analogy to multiplication, but instead of doubling l each iteration, we square it, and we multiply into the accumulator rather than adding into it.
;;; Problem 6. Define (pow l r), returns l raised to the r power,
;;; where l is positive and r is non-negative.
(defun fem (b e m)
(if (zerop e)
m
(multiple-value-bind (e* e0) (shr e)
(fem (mul b b) e* (if (zerop e0) m (mul b m))))))
(defun pow (b e) (fem b e 1))
For division we use a curious recursion. To divide a big number n by a divisor d, we first pass the buck and divide by (* d 2) and get a quotient and remainder. The quotient we return is twice the quotient we got back, plus 1 if the remainder we got back is bigger than d. We either return the remainder we got back or we subtract d from it.
I find this curious because one usually performs a recursion by making one of the arguments in some way smaller on each recursive call. The recursion bottoms out when the argument can get no smaller. In this recursion, however, we keep trying to divide by bigger and bigger divisors until we cannot anymore.
;;; Problem 7. Define (div l r), returns the quotient and remainder
;;; of l/r. l is non-negative and r is positive.
(defun div (n d)
(if (> d n)
(values 0 n)
(multiple-value-bind (q r) (div n (shl0 d))
(if (> d r)
(values (shl0 q) r)
(values (shl1 q) (sub r d))))))
Logarithm should be analagous (mutatis mutandis).
;;; Problem 8. Define (log l r), returns the integer logarithm of l
;;; base r
(defun log (l r)
(if (> r l)
(values 0 l)
(multiple-value-bind (lq lr) (log l (mul r r))
(if (> r lr)
(values (shl0 lq) lr)
(values (shl1 lq) (div lr r))))))