The idle puzzles got some web traffic, so here are a couple more in the same vein. Not much new, just a variation on a theme. They can be done in your head, but I spent a few minutes coding up some solutions to see what was involved.
In the previous puzzles, you were given these numeric primitives:
(import 'cl:zerop (find-package "PUZZLE")) (defun puzzle::shr (n) (floor n 2)) (defun puzzle::shl0 (n) (* n 2)) (defun puzzle::shl1 (n) (1+ (* n 2)))and the task was to implement basic arithmetic on non-negative integers.
These puzzles extend the task to include negatve numbers. We are given one additional primitive:
(defun puzzle::-1? (n) (= n -1))
If you want challenge yourself, you could speedrun the problems
from start to finish. Or try to adapt the solutions to the prior
puzzles with the minimal amount of editing and new code (minimize
the diff). Another thing you could try is
instrumenting shr, shl0,
and shl1 to count the amount of shifting taking place
and try to minimize that.
Here is the puzzle:
;;; -*- 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)))
(defun puzzle::-1? (n) (= n -1)) ;; new primitive
(in-package "PUZZLE")
;;; You can only use the symbols you can access in the PUZZLE package.
;;; Problem -1 (Example). Fix = to handle negative numbers.
(defun = (l r)
(cond ((zerop l) (zerop r))
((-1? l) (-1? r)) ;; new base case
((zerop r) nil)
((-1? r) nil) ;; new base case
(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. Implement minusp and plusp.
;;; Problem 1. Fix > to handle negative numbers.
;;; Problem 2. Fix inc and dec to handle negative numbers.
;;; Problem 3. Implement logand, logior, and logxor.
;;; Problem 4. Implement neg (unary minus).
;;; Problem 5. Fix add and sub to handle negative numbers.
;;; Problem 6. Fix mul to handle negative numbers.
;;; Problem 7. Implement floor and ceiling for both positive and
;;; negative numbers
My Solutions
The reason we're given a new primitive, -1?, is
because the shr function has two fixed points: 0, and
-1. So when we write code that recurs over a shr, the
recursion is going to bottom out in one of those two base cases and
we need to distinguish between them.
The earlier puzzles ensured we'd bottom out at zero by specifying
non-negative numbers, but if we allow negative numbers, our
recursions could bottom out at -1.
;;; Problem 0. Implement minusp and plusp
(defun minusp (n)
(cond ((zerop n) nil)
((-1? n) t)
(t (minusp (shr n)))))
(defun plusp (n)
(not (or (zerop n)
(minusp n))))
We have to handle both base cases for both the arguments:
;;; Problem 1. Fix > to handle negative numbers.
(defun > (l r)
(cond ((zerop l) (minusp r))
((-1? l) (and (minusp r)
(not (-1? r))))
((or (zerop r)
(-1? r)) (plusp l))
(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 is interesting. The base case handles when one or the other
argument is 0 or -1, but the recursive case doesn't know if
the arguments are positive or negative. It doesn't seem to care,
either. What is going on? This is the result of
using floor on a negative number. The remainder is
still a positive number, so when we operate on l0
and r0 we treat them as positive numbers regardless of
whether l or r are positive or
negative.
;;; Problem 2. Fix inc and dec to handle negative numbers.
(defun inc (n)
(if (-1? n)
0
(multiple-value-bind (n* n0) (shr r)
(if (zerop n0)
(shl1 n*)
(shl0 (inc n*))))))
(defun dec (n)
(if (zerop n)
-1
(multiple-value-bind (n* n0) (shr r)
(if (zerop n0)
(shl1 (dec n*))
(shl0 n*)))))
Well that was easy, we just had to handle the zero crossing.
No doubt you've noticed that shr shifts a number to the right as if it were held in
a register. If you shift the bits out of a negative number, you
will notice that the bits come out as if the number were "stored" in
two's complement form, with negative numbers being infinitely
extended to the left with 1s. This is curious because we didn't design or
choose a two's complement representation, it just sort of appears.
;;; Problem 3. Implement logand, logior, and logxor.
(defun logand (l r)
(cond ((zerop l) 0)
((-1? l) r)
((zerop r) 0)
((-1? r) l)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (or (zerop l0) (zerop r0))
(shl0 (logand l* r*))
(shl1 (logand l* r*))))))))
(defun logior (l r)
(cond ((zerop l) r)
((-1? l) -1)
((zerop r) l)
((-1? r) -1)
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (and (zerop l0) (zerop r0))
(shl0 (logior l* r*))
(shl1 (logior l* r*))))))))
(defun complement (n)
(cond ((zerop n) -1)
((-1? n) 0)
(t (multiple-value-bind (n* n0) (shr n)
(if (zerop n0)
(shl1 (complement n*))
(shl0 (complement n*)))))))
(defun logxor (l r)
(cond ((zerop l) r)
((-1? l) (complement r))
((zerop r) l)
((-1? r) (complement l))
(t (multiple-value-bind (l* l0) (shr l)
(multiple-value-bind (r* r0) (shr r)
(if (or (and (zerop l0) (zerop r0))
(and (not (zerop l0)) (not (zerop r0))))
(shl0 (logxor l* r*))
(shl1 (logxor l* r*))))))))
;;; Problem 4. Implement neg (unary minus).
(defun neg (n)
(cond ((zerop n) 0)
((-1? n) 1)
(t (multiple-value-bind (n* n0) (shr n)
(if (zerop n0)
(shl0 (neg n*))
(shl1 (complement n*)))))))
This is basically (inc (complement n)), which is how
you negate a two's complement number, but inc and
the complement step have been folded together to reduce
the amount of shifting.
;;; Problem 5. Fix add and sub to handle negative numbers.
(defun add (l r)
(cond ((zerop l) r)
((-1? l) (dec r))
((zerop r) l)
((-1? r) (dec 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))
((-1? l) r)
((zerop r) (inc l))
((-1? r) 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*)))))))))
(defun sub (l r) (add l (neg r)))
The great thing about two's complement is that you can handle
negative numbers without changing how you handle the low order
bits. For add and addc, I only had to add
the two additional base cases for l or r
being -1.
By the way, you shouldn't define sub this way. It's
double the number of shifts.
;;; Problem 6. Fix mul to handle negative numbers.
(defun fma (l r a)
(cond ((zerop r) a)
((-1? r) (sub a l)) ;; added this line
(t (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))
Two's complement to the rescue again. The loop can treat the
low-order bits of r the same way regardless of
whether r is positive or negative.
;;; Problem 7. Implement floor and ceiling for both positive and
;;; negative numbers
(defun floor0 (n d)
(if (> d n)
(values 0 n)
(multiple-value-bind (q r) (floor0 n (shl0 d))
(if (> d r)
(values (shl0 q) r)
(values (shl1 q) (sub r d))))))
(defun ceil0 (n d)
(if (not (> n d))
(values 1 (sub n d))
(multiple-value-bind (q r) (ceil0 n (shl0 d))
(let ((r1 (add d r)))
(if (plusp r1)
(values (shl0 q) r)
(values (dec (shl0 q)) r1))))))
(defun floor (n d)
(if (minusp n)
(multiple-value-bind (q r) (ceiling (neg n) d)
(values (neg q) (neg r)))
(if (minusp d)
(multiple-value-bind (q r) (ceil0 n (neg d))
(values (neg q) r))
(floor0 n d))))
(defun ceiling (n d)
(if (minusp n)
(multiple-value-bind (q r) (floor (neg n) d)
(values (neg q) (neg r)))
(if (minusp d)
(multiple-value-bind (q r) (floor0 n (neg d))
(values (neg q) r))
(ceil0 n d))))
My original method for division doesn't work too well with negative numbers. I worked around that by
converting the problem to positive numbers and converting the answer back to negative numbers where appropriate. Supporting negative numbers for division is an exercise in
combinatorics. All this checking for minusp and calls
to neg cause a lot of shifting of numbers. There is
no doubt a better way, but my brain hurts now.