# smallest larger popcounts

Write a function accepting a natural number n and returning the smallest number larger than n having the same number of one bits.

``` \$ cat slp.rkt
#lang racket

(require srfi/1)

(define (explode n)

; Return a list of bits in the given natural number in little-endian order
; (lsb leftmost) and a trailing zero bit appended.

(let loop ((n n) (bits '()))
(if (zero? n)
(reverse (cons 0 bits))
(let-values (((q r) (quotient/remainder n 2)))
(loop q (cons r bits))))))

(define (implode bits)

; Return the natural number represented by the give list of bits in
; little-endian order (lsb leftmost).

(let loop ((bits bits) (po2 1) (n 0))
(if (null? bits)
n
(loop (cdr bits) (* po2 2) (+ (* (car bits) po2) n)))))

(define (slp n)

; Return the smallest value larger than n with the same number of 1s in its
; binary representation.

; The idea is to find the rightmost 01 bit pair in n (explode make sure such
; a pair exists) and swap them to get 10.  This produces n' the smallest
; number larger than n that can be produced by swapping a 01 pair.  n' can be
; made smaller but still greater than n by shifting all 1 bits to the right
; of the 01 pair to the right end of the number (shifting 0s in the opposite
; direction).

(let count-0s ((bits (explode n)) (zero-count 0))
(if (= (car bits) 0)
(count-0s (cdr bits) (+ zero-count 1))
(let count-1s ((bits (cdr bits)) (one-count 1))
(if (= (car bits) 1)
(count-1s (cdr bits) (+ one-count 1))
(implode
(append
(make-list (- one-count 1) 1)
(make-list zero-count 0)
'(0 1)
(cdr bits))))))))

(define (slp-2 n)

; Return the smallest value larger than n with the same number of 1s in its
; binary representation.

; This code is way stupid (a.k.a. super-exponential) , but it's "obviously
; correct" (generate all permutations of an n-bit number with i 1 bits) and
; useful for testing if the numbers don't get too big.

(define (swap! v i j)
(let ((t (vector-ref v i)))
(vector-set! v i (vector-ref v j))
(vector-set! v j t)))

(let*

((bits (list->vector (explode n)))
(bc (vector-length bits))
(best (expt 2 bc)))

(let outer-loop ((i 0))
(if (= i (- bc 1))

(let ((candidate (implode (vector->list bits))))
(when (and (> candidate n) (< candidate best))
(set! best candidate)))

(let inner-loop ((j (+ i 1)))
(unless (= j bc)
(swap! bits i j)
(outer-loop (+ i 1))
(swap! bits i j)
(outer-loop (+ i 1))
(inner-loop (+ j 1))))))

best))

(require rackunit)

(define (count-1s n)
(foldr + 0 (explode n)))

(do ((i 0 (+ i 1))) ((> i 100) #t)
(let ((n (random 1000000000)))
(check-eq? n (implode (explode n)))))

(do ((i 0 (+ i 1))) ((> i 10) #t)
(let* ((n (+ (random (expt 2 8)) 1))
(slp-n (slp n)))
(check-eq? slp-n (slp-2 n))
(check-eq? (count-1s slp-n) (count-1s n))
(check-true (> slp-n n))))

\$ racket slp.rkt
#t
#t

\$

```