Tuesday, April 24, 2012

Another little puzzle

Write a procedure that, given two integers L and R, produces the integer that results from interleaving the binary representation of L and R. For example, suppose L is 23 and R is 13. The binary representation of L is 10111. The binary representation of R is 1101. If we interleave the bits (starting with R and padding with zeros when necessary) we get 1001111011. The answer is therefore 635.

Of course this is easy if you print the numbers and then do string manipulation. Can you do it with arithmetic? Can you extend it to handle negative numbers?


John Cowan said...

This is the INTERCAL mingle operator, so #23 $ #13, which can also be written using any other currency symbol. More generally:

(4000) DO :1 <- .1 $ .2

is a routine invoked by "DO (4000) NEXT" that mingles the values of the 16-bit registers 1 and 2 and puts the result in the 32-bit register 1 (which is unrelated to the 16-bit register 1). That is, provided that no operand overloading [sic] is in effect. See C-INTERCAL 0.29 Revamped Instruction Manual for details.

Joe Marshall said...

Why, yes, it is.

And you didn't say PLEASE.

Arcane Sentiment said...

A two-line routine probably shouldn't have a PLEASE, lest it cause E099 PROGRAMMER IS OVERLY POLITE.

Haskell is not as concise as INTERCAL ;) but here's a solution in terms of the Moser-de Bruijn sequence:

interleave l r = mdb l * 2 + mdb r where
mdb 0 = 0
mdb n = b + 4 * mdb r where (r, b) = divMod n 2

Is there a similarly concise definition of mdb that avoids the boring explicit recursion?

Josh Ballanco said...

Well, this sounded like a fun challenge! My inexpert, probably rather inelegant, attempt:

(define divmod2 (lambda (n)
                  (cons (quotient n 2) (modulo n 2))))

(define interleave (lambda (L R)
                     (letrec ((interleave-place (lambda (L R place sum)
                                               (cond ((and (= L 0) (= R 0))
                                                       (let ((dm2 (divmod2 R)))
                                                             (interleave-place (car dm2)
                                                                               (+ place 1)
                                                                               (+ sum (* (cdr dm2) (expt 2 place))))))))))
                       (interleave-place L R 0 0))))

(display (interleave 23 13))

kbob said...

I don't have a solution for negative numbers of arbitrary precision. mingle(0, -1) is the infinite bit pattern ...010101010101010101...

JRH said...

A fast (int32, int32) => int64 solution in Kawa Scheme:

(define (mingle (l ::int) (r ::int)) ::long
  (let loop ((a ::int r) (b ::int l) (res ::long 0) (i ::int 0))
    (cond ((or (and (= a 0) (= b 0))
               (= i 64)) res)
          (else (loop b (bitwise-arithmetic-shift-right a 1)
                      (bitwise-ior res
                                    (bitwise-and a 1) i))
                      (+ i 1))))))

Here's one which works on arbitrary-precision integers. As kbob says, passing one negative argument and one non-negative argument will lead to a prefix of …101010101, which has a limit of positive infinity, so I check for that first. Is it cheating that +inf.0 isn't actually an integer?

(define (mingle2 (l ::integer) (r ::integer))
  (if (or (and (< l 0) (>= r 0))
            (and (< r 0) (>= l 0)))
        (let loop ((a ::integer r) (b ::integer l)
                   (res ::integer 0) (i ::integer 0))
          (cond ((and (= 0 a) (= 0 b)) res)
                ((and (= -1 a) (= -1 b))
                 (bitwise-ior res (bitwise-arithmetic-shift-left -1 i)))
                (else (loop b (bitwise-arithmetic-shift-right a 1)
                            (bitwise-ior res
                                          (bitwise-and a 1) i)) (+ i 1)))))))

pjb said...

Two Common Lisp solutions. (They work nicely when both arguments are negative, but not when they're of different sign, since in CL negative numbers are represented with an infinite sequence of 1 bits on the left).

(defun interleave (l r)
(when (minusp (* l r))
(error "No can do."))
:until (and (zerop l) (zerop r))
:for pow = 1 :then (* pow 4)
:sum (* pow (+ (* 2 (rem l 2)) (rem r 2)))
:do (setf l (truncate l 2)
r (truncate r 2))))

(defun interleave (l r)
(multiple-value-bind (lq lb) (truncate l 2)
(multiple-value-bind (rq rb) (truncate r 2)
(+ lb lb rb (if (and (zerop lq) (zerop rq))
(* 4 (interleave lq rq)))))))

(progn (format t "~B ~:* ~D~%" (interleave 23 13))
(format t "~B ~:* ~D~%" (interleave -23 -13)))
1001111011 635
-1001111011 -635